AW: Variable in Macro
22.10.2008 11:25:26
fcs
Hallo Ratzewatz,
mit folgender Anpassung kannst du die Textdatei für die Querry variabel im Dateidialog wählen.
Den Text-Import-Assistenten kannst du meines Wissen nur starten, indem du die Textdatei mit dem Excel-Datei-Öffnen-Dialog öffnest.
Gruß
Franz
Sub Z_Daten_laden()
Dim varFileName, varQuerryName
'Textdatei auswählen
varFileName = Application.GetOpenFilename(Filefilter:="text(*.txt),*.txt", _
Title:="Bitte Textdatei mit Daten auswählen")
If varFileName = False Then Exit Sub
'Defaultname für Querry ermitteln
varQuerryName = Mid(varFileName, InStrRev(varFileName, "\") + 1)
varQuerryName = Left(varQuerryName, Len(varQuerryName) - 4)
'Name der Querry eingeben
varQuerryName = InputBox(Prompt:="Name der Query?", Title:="Querry Textdatei", _
Default:=varQuerryName)
If varQuerryName = "" Then Exit Sub
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & varFileName, Destination:=Range( _
"A1"))
.Name = varQuerryName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Sub Text_Daten_laden()
Dim varFileName
On Error GoTo Fehler
'Textdatei auswählen und öffnen (startet Text-Import-Assistenten)
varFileName = Application.Dialogs(xlDialogOpen).Show("*.txt")
If varFileName = False Then GoTo Fehler
ActiveSheet.Columns.AutoFit
Fehler:
If Err.Number 0 Then
MsgBox "Fehler-Nr.: " & Err.Number & vbLf & Err.Description
End If
End Sub