Hallo zusammen!
Ich habe folgenden Code in einer Liste, der Daten aus einer anderen Datei ausliest . Dieser funktioniert auf meinem PC nur bei allen anderen Kollegen nicht. Woran kann das liegen? Es kommt auch keine Fehlermeldung, sondern es rührt sich einfach gar nichts. Was könnte das denn sein?
Hier mein Code:
Private Sub cmbEinlesen_Click()
Const SUCHORDNER As String = "C:\SapWorkDir"
'Aus diesem Ordner werden Daten bezogen
Dim FSO As New Scripting.FileSystemObject
Dim Ordner As Scripting.Folder
Dim DateiListe As Scripting.Files
Dim Datei As Scripting.File
Dim strDatei As String
Dim SuchString As String
Dim xlWB As Excel.Workbook
Set Ordner = FSO.GetFolder(SUCHORDNER)
If Ordner Is Nothing Then Exit Sub
Set DateiListe = Ordner.Files
If DateiListe Is Nothing Then Exit Sub
SuchString = Application.InputBox("Auftragsnummer eingeben ", "Kopfdaten einlesen", , , , , , 2)
'Zunächst muss die Auftragsnummer eingegeben werden und anhand dieser wird dann die dazugehörige Datei geöffnet
SuchString = UCase(SuchString)
SuchString = "00" & SuchString & "-D-SPT-"
'Datei ist nicht nur nach Auftragsnummer benannt, sondern enthält auch noch zusätzl. Zeichen "00" und "-D-SPT-"
For Each Datei In DateiListe
'Schleife wird gestartet, d.h. er durchsucht kompletten Ordner nach der richtigen Datei
strDatei = UCase(Datei.Name)
If strDatei <> UCase(ThisWorkbook.Name) Then
If InStr(1, strDatei, SuchString, vbBinaryCompare) <> 0 Then
Set xlWB = Workbooks.Open(SUCHORDNER & "\" & Datei.Name)
xlWB.Activate
ThisWorkbook.Sheets(1).Range("D2") = xlWB.Sheets(1).Range("F20")
ThisWorkbook.Sheets(1).Range("D3") = xlWB.Sheets(1).Range("F14")
ThisWorkbook.Sheets(1).Range("D4") = xlWB.Sheets(1).Range("F27")
ThisWorkbook.Sheets(1).Range("G3") = xlWB.Sheets(1).Range("F16")
xlWB.Close True
'Wenn Datei gefunden wurde, wird diese geöffnet und die entsprechenden Daten in das Tabellenblatt "Allgemein" übernommen
'Anschließend werden mit dem Code in "DieserArbeitsmappe" die Daten von "Allgemein" in die anderen Tabellenblätter übernommen
'Zum Schluss wird die Datei, aus der Daten gezogen werden wieder geschlossen
Set xlWB = Nothing
Exit For
End If
End If
Next
Set DateiListe = Nothing
Set Ordner = Nothing
End Sub
DANKE! |