ich habe für mich riesiges Problem. Nachdem ich das Service Pack 3 für Office 2000 installiert habe, gibt es Probleme beim Ausführen eines Makros.
Mein Makro ließt mir CSV- Dateien ein. Dafür werden im Hintergrund die CSV- Dateien geöffnet, die relevanten Daten kopiert, danach die Datei wieder geschlossen und die kopierten Daten werden in meine Exceltabelle eingefügt. Mein Problem ist nun folgendes. Beim Öffnen der CSV- Dateien wird nicht mehr nach Semikolon getrennt. Somit stehen die eingefügten Daten dann nicht in verschiedenen Spalten sondern alle in einer Spalte. Öffne ich hingegen die CSV- DATEI über die Menüleiste, also normal, wird das Semikolon als Trennzeichen erkannt und die Daten werden in einzelne Spalten geschrieben.
Ich weis nicht mehr wo ich noch suchen soll. Ich hoffe, einer von Euch hat noch eine Idee?
Nachfolgend habe ich noch mein Makro aufgeführt.
Global gdatnam(1 To 1000) As String
Private Sub Dateinamen_Lesen(upfad As String)
On Error GoTo fehlerhandler
' Das Beispiel verwendet zur Suche der Dateien das
' FileSearch-Objekt. dazu benötigt man einen verweis
' auf die MS Office 8.0 bzw. 9.0 Objektbibliothek
Dim DateiinhaltStr As String
Dim DateinameStr As String
Dim FsoObj As FileSearch
Dim i As Long
Dim j As Integer
Dim PfadDateiStr As String
Dim SuchergebnisLng As Long
Dim xfeld As String
' File-System-Objekt anlegen
Set FsoObj = Application.FileSearch
With FsoObj
' nur csv-files importieren
.FileType = msoFileTypeAllFiles
.Filename = "*.csv"
' Verzeichnis angeben, das durchsucht werden soll
.LookIn = upfad
' Unterverzeichnisse nicht mitdurchsuchen
.SearchSubFolders = False
' Suche ausführen
SuchergebnisLng = .Execute(msoSortByFileName, msoSortOrderAscending)
' Wurde überhaupt ein File gefunden ?
If SuchergebnisLng > 0 Then
' alle gefundenen Files durchgehen
For i = 1 To .FoundFiles.Count
' Dateinamen des aktuellen Files mitsamt Pfadangabe auslesen
PfadDateiStr = .FoundFiles(i)
' zuerst die Pfadangabe eleminieren
DateinameStr = PfadDateiStr
Do While InStr(DateinameStr, "\")
DateinameStr = Right(DateinameStr, Len(DateinameStr) - InStr(DateinameStr, "\"))
Loop
' gefundene Dateinamen in Globalem Array ablegen
If i < 1001 Then
gdatnam(i) = DateinameStr
End If
Next i
End If
End With
verlassen:
On Error Resume Next
Set FsoObj = Nothing
Exit Sub
fehlerhandler:
MsgBox CStr(Err.Number) & ":" & Err.Description, vbCritical
Resume verlassen
End Sub
Sub Ablesung()
Dim umon As String
Dim ujahr As String
Dim xwei As Integer
Dim xpfad As String
Dim xdatei As String
Dim xfeld As String
Dim xlastrow As Integer
Dim i1 As Integer
Dim i2 As Integer
Dim xerl(1 To 1000) As String
umon = ActiveSheet.Name
ujahr = Right(ActiveWorkbook.Name, 8)
ujahr = Left(ujahr, 4)
xpfad = "\\Samson\Samson D\WMZ_Archiv\" & ujahr & "\" & umon & Right(ujahr, 2) & "\"
ChDir xpfad
Dateinamen_Lesen (xpfad)
On Error GoTo 0 ' allg. Fehlerbehandlung wieder eingeschaltet
Sheets(umon).Select
' letzte Zeile ermitteln
With Range("A1")
xlastrow = .SpecialCells(xlCellTypeLastCell).Row
End With
For i1 = 3 To xlastrow
xfeld = Cells(i1, 1).Value
' aus der 1.Spalte wird der Dateiname abgeleitet
If Mid(xfeld, 2, 1) = "-" Then
xdatei = "A" & Mid(xfeld, 3, 4) & ".CSV"
xwei = 0
For i2 = 1 To 1000 ' Datei vorhanden ?
If xdatei = gdatnam(i2) Then
xwei = 1
i2 = 1001
End If
Next i2
If xwei = 1 Then
Workbooks.Open Filename:=xpfad & xdatei
Range("A3:C3").Select
Selection.Copy
ActiveWindow.Close
Cells(i1, 5).Select
ActiveSheet.Paste
If i1 < 1001 Then
xerl(i1) = "A"
End If
End If
End If
Next i1
Range("A1").Select
Sheets("Dateien").Select
i2 = 0
For i1 = 4 To 15
If Cells(2, i1) = umon Then
i2 = i1
i1 = 16
End If
Next i1
' im Tabellenblatt Dateien als erledigt merkieren
If i2 > 0 Then
For i1 = 3 To 1000
If xerl(i1) = "A" And _
(Cells(i1, i2).Value = "" Or _
Cells(i1, i2).Value = " " Or _
IsNull(Cells(i1, i2).Value)) Then
Cells.NumberFormat = "d/m/yy"
Cells(i1, i2).Value = Date
End If
Next i1
End If
Sheets(umon).Select
End Sub
Danke Euch schon mal für die Hilfe,
Oliver