Hallo,
ich habe ein ziemlich seltsames Problem mit einem Makro, das die CSV-Dateien öffnen soll. Am Anfang habe ich das Bestimmen des Ordners, wo sich die CSV-Dateien befinden, mit der InputBox gemacht. Es hat Alles einwandfrei funktioniert. Jetzt wollte ich es etwas komfortabler gestalten und habe einen BrowseForFolder-Dialog eingefügt. Nun macht das Makro Probleme, und das Seltsame dabei ist, an einer Stelle, die vorher funktioniert hat. Vielleicht als Hinweis, Ordnerauswahldialog funktioniert einwandfrei.
Das Problem tritt in der folgenden Zeile auf:
Application.Workbooks.OpenText (strPath & strFilename), , , , , , , , Semicolon, Comma
Und zwar meckert der Debugger, dass „Semicolon“ und „Comma“ nicht definiert sind. Ich finde, es ist Quatsch, denn sie gehören ja zur Funktion OpenText und werden so erwartet.
Ich poste nun das komplette Makro, hoffe, dass mir jemand helfen kann. Ich bin im Voraus dankbar!.
Viele Grüße,
Michael
'DAS KOMPLETTE CODE BEFINDET SICH IN EINEM MODUL
Option Explicit
' Benötigte API-Deklarationen
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Const MAX\_PATH = 260
Private Const BIF\_RETURNONLYFSDIRS = &H1
Private Const BFFM\_SETSELECTION = &H466
Private Const BFFM\_INITIALIZED = 1
Private Declare Sub CoTaskMemFree Lib "ole32.dll" \_
(ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias \_
"lstrcatA" (ByVal lpString1 As String, \_
ByVal lpString2 As String) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" ( \_
ByVal pidList As Long, \_
ByVal lpBuffer As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" ( \_
lpbi As BrowseInfo) As Long
Private Declare Function SendMessage Lib "user32.dll" \_
Alias "SendMessageA" ( \_
ByVal hWnd As Long, \_
ByVal Msg As Long, \_
wParam As Any, \_
lParam As Any) As Long
Private m\_BrowseInitDir As String
' Ordnerauswahl-Dialog mit optionaler
' Angabe eines Startverzeichnisses
Public Function BrowseForFolder(ByVal sPrompt As String, \_
Optional ByVal sInitDir As String) As String
Dim nPos As Long
Dim nIDList As Long
Dim sPath As String
Dim oInfo As BrowseInfo
m\_BrowseInitDir = sInitDir
' Datenstruktur füllen
With oInfo
.hWndOwner = GetActiveWindow()
.lpszTitle = lstrcat(sPrompt, "")
.ulFlags = BIF\_RETURNONLYFSDIRS
If sInitDir "" Then
' Callback-Funktionsadresse
.lpfnCallback = FuncCallback(AddressOf BrowseCallback)
End If
End With
' Dialog anzeigen und auswerten
nIDList = SHBrowseForFolder(oInfo)
If nIDList Then
sPath = String$(MAX\_PATH, 0)
Call SHGetPathFromIDList(nIDList, sPath)
Call CoTaskMemFree(nIDList)
nPos = InStr(sPath, vbNullChar)
If nPos Then sPath = Left$(sPath, nPos - 1)
End If
BrowseForFolder = sPath
End Function
Private Function BrowseCallback(ByVal hWnd As Long, \_
ByVal uMsg As Long, \_
ByVal wParam As Long, \_
ByVal lParam As Long) As Long
Select Case uMsg
Case BFFM\_INITIALIZED
' Start-Ordner
Call SendMessage(hWnd, BFFM\_SETSELECTION, ByVal 1&, \_
ByVal m\_BrowseInitDir)
End Select
BrowseCallback = 0
End Function
' Hilfsfunktion für AddressOf
Private Function FuncCallback(ByVal nParam As Long) As Long
FuncCallback = nParam
End Function
Sub CSV()
Dim wbCSV As Workbook, wbDatei As Workbook, Blattname As String
Dim strPath As String, BoxTitel As String, BoxPrompt As String
Dim strFilename As String, NameAnfang As String
Dim Farbe As Integer, I As Integer
' SO HAT ES FUNKTIONIERT!
'BoxTitel = "Exercise documentation files import"
'strPath = InputBox("Enter the location of exercise documentation files", BoxTitel, "C:\")
'If strPath = "" Then Exit Sub
' DIESE VARIANTE BRINGT EINEN FEHLER MIT SICH!
strPath = BrowseForFolder("Please select the directory:")
strPath = strPath & "\"
MsgBox strPath
If strPath = "" Then Exit Sub
NameAnfang = InputBox("Enter exercise name:", BoxTitel)
If NameAnfang = "" Then Exit Sub
BoxPrompt = "Do you want to open a new workbook?" & vbLf & vbLf
BoxPrompt = BoxPrompt & " Answer with 'no', if you want to open a new file."
If MsgBox(BoxPrompt, vbYesNo + vbQuestion, BoxTitel) = vbYes Then
Workbooks.Add Template:="Workbook"
Else
If Application.Dialogs(xlDialogOpen).Show = False Then Exit Sub
End If
Set wbDatei = ActiveWorkbook
strFilename = Dir(strPath & NameAnfang & "\*.csv", vbNormal)
Do Until strFilename = ""
Application.Workbooks.OpenText (strPath & strFilename), , , , , , , Semicolon, Comma 'FEHLER!!!
Set wbCSV = ActiveWorkbook
Blattname = wbCSV.Sheets(1).Name
Farbe = 6 'yellow as background color
With .Range(Cells(1, 1), Cells(1, .UsedRange.Column + .UsedRange.Columns.Count - 1))
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = Farbe
End With
End With
For I = 1 To wbDatei.Sheets.Count
If wbDatei.Sheets(I).Name = Blattname Then
wbDatei.Sheets(I).Delete
wbCSV.Sheets(1).Copy Before:=wbDatei.Sheets(I)
GoTo weiter1
End If
Next
wbCSV.Sheets(1).Copy Before:=wbDatei.Sheets(1)
weiter1:
wbCSV.Close False
strFilename = Dir
Loop
End Sub