makro mit kleinem fehler....
08.02.2008 20:32:00
christian
das folgende makro ist unter anderem mit euerer hilfe zustande gekommen. heut habe ich es im geschäft eingesetzt und mir noch einen kleinen nervigen, mir unerklärlichen mangel gezeigt.
wenn ich das makro zum ersten mal starte und ich mit der InputBox die zusatzwerte erfasse (für jedes txt file das zusammengefügt wird ein individueller wert) erfolgt der durchlauf zwei mal. sind die im excelfile zu importierenden zellen schon mit einem wert aus einem früheren import, erfolgt der durchlauf (erfassen des zusatzwertes mit der InputBox) nur einmal, so wie es sein soll.
versteht ihr das?
Sub Start_Rohdaten_ImportTXT()
Worksheets("Rohdaten").Activate
Dim myPath As String
Dim myOutputFile As String
myPath = Range("MacroValues!B2").Value
myOutputFile = Range("MacroValues!B3").Value
'myPath = "C:\Analyzer_Tool\" 'wichtig: am Schluss muss ein \ _
stehen
'myOutputFile = "output.txt"
MergeFiles myPath, myOutputFile
Import_TXT myPath & myOutputFile, "$b$1", "b:h"
Application.Dialogs(xlDialogSaveAs).Show
End Sub
Sub MergeFiles(SourceFolder As String, OutputFile As String) 'Zusammenfügen nummerierter .txt _
Dateien in aufsteigender Richtung
Dim i As Integer
Dim Textzeile As String
Dim Dateiname As String
Dim numOut As Integer
Dim numIN As Integer
Dim strNum As String, n As Integer
numOut = FreeFile
Open SourceFolder & OutputFile For Output As #numOut
Dateiname = Dir(SourceFolder & "*.txt")
Do While Not Dateiname = ""
If Dateiname OutputFile Then
n = 0
numIN = FreeFile
strNum = InputBox("Aktuelle Datei: " & Dateiname & Chr(13) & Chr(10) & "Bitte Anzahl _
Sporen oder DNA-Konzentration erfassen:", "Zusatz", "")
Open SourceFolder & Dateiname For Input As #numIN 'Öffne gefundene Datei
Do While Not EOF(numIN) 'Schleife bis Dateiende.
Line Input #numIN, Textzeile 'Zeile in Variable einlesen.
n = n + 1
If n = 3 Then 'einfügen in Zeile 3
Textzeile = Textzeile & Chr(32) & strNum
End If
Print #numOut, Textzeile 'Ausgabe in Datei.
Loop
Close #numIN
End If
Dateiname = Dir
Loop
Close #numOut
End Sub
Sub Import_TXT(Filename As String, Position As String, DataRange As String)
Range(DataRange).Select
Selection.ClearContents
MsgBox "DataRange: " & DataRange & " deleted!"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Filename, Destination:=Range( _
Position))
.Name = Filename
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(6, 12, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub