Hallo zusammen
Ich komme leider nicht weiter bei meinem Code respektie kommt ein Laufzeitfehler.
Ausgangslage:
Ins Userform wird eine Datei raufgeladen. Den Pfad wird in eine TextBox geschrieben, welche nacher über einen anderen Button aufgerufen werden kann.
Ich möchte nun
Button 1: File Upload DIalog öffnen und Datei auswählen (das funktioniert soweit)
Button 2: Die ausgewählte Datei im Hintergrund öffnen und die Spalten A - F kopieren und in die Listbox anzeigen lassen
Button 3: In ein Tabellenblatt schreiben (fungiert als Datenbank)
folgender Code habe ich schon geschrieben:
Private Sub CommandButton2_Click()
Dim fd As FileDialog
Dim file As Variant
Dim textbox118 As String
On Error Resume Next
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.InitialFileName = ActiveWorkbook.Path
If .Show = -1 Then
For Each file In .SelectedItems
TextBox1.Value = .SelectedItems(1)
Next file
Else
End If
End With
Set fd = Nothing
End Sub
Private Sub CommandButton3_Click()
Dim countx As Integer
Dim wbOpened As Workbook
Dim strFilePath As String
Dim ListItems As Variant, i As Integer
'Initialize the variables
strFilePath = TextBox1.Text
' Make sure that the file exits
If TextBox1.Value = "" Then
MsgBox ("Bitte File auswählen")
Exit Sub
' Open the workbook and assign it to the variable
Else
With Me.ListBox1
.Clear ' remove existing entries from the listbox
' turn screen updating off,
' prevent the user from seeing the source workbook being opened
Application.ScreenUpdating = False
' open the source workbook as ReadOnly
Set wbOpened = Workbooks.Open(TextBox1.Value)
ListItems = wbOpened.Worksheets(1).Range("A1:F13").Value
' get the values you want
wbOpened.Close True ' close the source workbook without saving changes
Set wbOpened = Nothing
ListItems = Application.WorksheetFunction.Transpose(ListItems)
' convert values to a vertical array
For i = 1 To UBound(ListItems)
.AddItem ListItems(i) ' populate the listbox
Next i
.ListIndex = -1 ' no items selected, set to 0 to select the first item
Application.ScreenUpdating = True
End With
End If
End Sub
Ich hoffe es kann mir jemand weiterhelfen. Ich danke euch im Voraus für eure Hilfe
Ihr findet das Dokument noch angehängt.
Cherrs
Rizzo91