Aus UserForm Listbox Dateien öffnen?
07.12.2004 16:54:37
Andreas
ich habe folgendes Problem und hoffe mir kann jemand von euch Excel-Profis helfen:
Habe in meiner UserForm zwei ListBoxen, die beim starten der UserForm gefüllt werden. Es werden jeweils Excel-Dateien (der komplette Pfad) aus bestimmten Verzeichnissen angezeigt. Nach Auswahl der Dateien werden diese nacheinander geöffnet und bestimmte Bereiche in meine Mappe kopiert.
Mein Problem ist, dass ich in den ListBoxen nur den Dateinamen stehen haben will und nicht den kompletten Pfad. Hat einer ne Idee? Danke im Voraus
Grüsse
Andreas
Private Sub UserForm_Initialize()
Dim iCounter As Integer
Dim strBaseFilePath As String
Dim strOptFilePath As String
strBaseFilePath = ThisWorkbook.Path & "\Basecase\"
strOptFilePath = ThisWorkbook.Path & "\Option\"
With Application.FileSearch
.LookIn = strBaseFilePath
.SearchSubFolders = False
.Execute msoSortByFileName
For iCounter = 1 To .FoundFiles.Count
lstBaseFile.AddItem .FoundFiles(iCounter)
Next iCounter
End With
With Application.FileSearch
.LookIn = strOptFilePath
.SearchSubFolders = False
.Execute msoSortByFileName
For iCounter = 1 To .FoundFiles.Count
lstOptFile.AddItem .FoundFiles(iCounter)
Next iCounter
End With
End Sub
Private Sub AddDataToWorksheet(ByVal wksDest As Worksheet, _
ByVal lstListBox As MSForms.ListBox)
Dim iCounter As Integer
Dim wkbSrc As Workbook
Dim rngSrc As Range
Dim intCol As Integer
Dim lngRow As Long
Dim strBaseFileName() As String
intCol = 23
Application.ScreenUpdating = False
With wksDest
If Application.WorksheetFunction.CountA( _
.Columns(intCol).EntireColumn) > 0 Then
lngRow = .Cells(.Rows.Count, intCol).End(xlUp).Row + 2
Else
lngRow = 1
End If
End With
For iCounter = 0 To lstListBox.ListCount - 1
If lstListBox.Selected(iCounter) Then
Set wkbSrc = Workbooks.Open(lstListBox.List(iCounter))
With wkbSrc.Worksheets(1)
Set rngSrc = .Range(.Cells(90, 7), .Cells(137, 27))
wksDest.Cells(lngRow, 23).Resize(rngSrc.Rows.Count, _
rngSrc.Columns.Count) = rngSrc.Value
lngRow = lngRow + rngSrc.Rows.Count
Set rngSrc = Nothing
End With
wkbSrc.Close False
Set wkbSrc = Nothing
End If
Next iCounter
Application.ScreenUpdating = True
End Sub
Anzeige