Dir$() (VBA)

AndTi, Donnerstag, 29.11.2018, 13:53 (vor 10 Tagen)

Hi,

vll hat jemand eine Lösung zu dem hier vorgestellten Problem. Ich versuche mehrere Files innerhalb eines Ordners zu "mergen" während ich die Dir$() Function nutze. Problem ist hier, dass bei der zweiten Dir() ein vbNullstring ausgegeben wird anstatt die Argumente des ersten Dir zurückzugeben.

Any suggestions welcome!

Sub Import()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
MsgBox "Please select the folder where your Pre-filled LDRS files and filled-in Bank Comments files are saved."
strPath = GetPath
MsgBox "Please select the folder where you want to save your Final files."
strPathNew = GetPath

If Not strPath = vbNullString Then
strFile = Dir$(strPath & "*.xlsx", vbNormal)

Do While Not strFile = vbNullString
Dim wsource As Workbook, ws As Worksheet, wtarget As Workbook, wt As Worksheet, i As Integer, j As Integer
Set wsource = Workbooks.Open(strPath & strFile, UpdateLinks:=False)
Set ws = wsource.Sheets("Source";)

targetfile = Mid(wsource.Name, 1, Len(wsource.Name) - 18)
target = Dir$(strPath & targetfile & "*.xlsm", vbNormal)
If Not target = vbNullString Then
Set wtarget = Workbooks.Open(strPath & target)
Set wt = wtarget.Sheets("Target";)

For i = 1 To 300
For j = 1 To 50
If ws.Cells(i, j).Interior.Color = RGB(218, 238, 243) Then
wt.Cells(i, j) = ws.Cells(i, j)
End If
Application.DisplayAlerts = True
Next j
Next i

wt.Cells(4, 5) = Date
wtarget.SaveAs strPathNew & Mid(wsource.Name, 1, Len(wsource.Name) - 18) & "_Final.xlsm"
wtarget.Close
wsource.Close
strFile = Dir$()
End If
Loop
End If
End Sub


gesamter Thread:

 RSS-Feed dieser Diskussion

powered by my little forum