xls Datei wird nicht gefunden
16.06.2007 21:15:57
Metin
Habe erneut ein Problem.
Mit dem Teil des Makros bekomme ich keine Dateien mehr auf woran liegt das ?
Vielen Dank im voraus.
Private Sub cmdEingabe_Click()
If optManu = True Then GoTo Kabelvergleich Else GoTo automatisch
automatisch:
If optAuto = True And txtDatensatz = "" Then MsgBox ("Es wurde kein Datensatz angegeben."): Exit Sub
Dim Zellenanzahl As Integer
Dim Datensatzabfrage As Integer
Dim Zeile As Integer
Dim wb As Workbook
Dim WBopen As String
Dim zeigen As String
Dim i As Integer
optArbeitsmappe = True
Zeile = 5
For Each wb In Application.Workbooks
If UCase(wb.Name) = UCase(txtDatensatz & ".xls") Then
WBopen = True
GoTo automatischweiter
End If
Next wb
WBopen = False
Dim objFSO As Object, objDrive As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objDrive In objFSO.Drives
If objDrive.IsReady Then
With Application.FileSearch
.LookIn = objDrive.Path
.Filename = txtDatensatz & ".xls"
.SearchSubFolders = True
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
zeigen = .FoundFiles(i)
Debug.Print zeigen
Next
End If
End With
End If
Next
Set objFSO = Nothing
If WBopen = False And i <> 2 Then MsgBox (txtDatensatz & ".xls" & " wurde nicht gefunden."): Windows("Messprocreator").Activate: Exit Sub Else GoTo automatischweiter
'Application.Workbooks.Open (txtDatensatz)
automatischweiter:
Windows(Me.txtDatensatz.Text).Activate
Zellenanzahl = ActiveSheet().Range("A5:A65536").SpecialCells(xlCellTypeConstants).Count
For Datensatzabfrage = 1 To Zellenanzahl
Windows(Me.txtDatensatz.Text).Activate
txtKabelnummer = Workbooks(Me.txtDatensatz.Text).ActiveSheet().Cells(Zeile, 1).Value
cboKabelart = Workbooks(Me.txtDatensatz.Text).ActiveSheet().Cells(Zeile, 2).Value
cboKabeltyp = Workbooks(Me.txtDatensatz.Text).ActiveSheet().Cells(Zeile, 3).Value
txtKabellänge = Workbooks(Me.txtDatensatz.Text).ActiveSheet().Cells(Zeile, 5).Value
Windows("Messprocreator").Activate
GoTo Kabelvergleich