Dateien Verschieben - Vorgaben in Tabellenblatt

Hallo zusammen,
irgendwie kann ich nicht finden was ich suche und brauche. Folgender Sachverhalt:
Es wurde in einem Hauptordner und darunter vielen Subordnern Dokumente (pdf und word) in eine Exceltabelle registriert.
In der Exceltabelle steht in Spalte "B" der Dateiname allerdings OHNE Dateiendung, diese steht in Spalte "AN".
In Spalte "AJ" steht der Quellort der Datei bzw. der Pfad unter dem die Datei aktuell noch liegt.
Es wurde nun in einem Workshop bestimmt, wo die Dokumente NEU zu finden sind. Dieser Zielpfad steht in AI.
Ich möchte nun mittels VBA ein Makro welches jede einzelne Tabellenzeile durchgeht und die genannte Datei in Spalte "B" von Quellpfad "AJ" nach Zielpfad "AI" verschiebt.
Könnte mir da bitte jemand helfen, das übersteigt tatsächlich meine VBA Fähigkeiten.
Vielen Besten Dank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Frank,
teste mal:

Option Explicit
Private Declare PtrSafe Function MoveFileA Lib "kernel32.dll" ( _
ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String) As Long
Public Sub Start()
Dim avntValues As Variant
Dim ialngIndex As Long
Dim strFilename As String, strOldPath As String, strNewPath As String
With Worksheets("Tabelle1") 'Tabellennamen anpassen !!!
avntValues = .Range(.Cells(4, 1), .Cells( _
.Cells(.Rows.Count, 2).End(xlUp).Row, 40)).Value
End With
For ialngIndex = LBound(avntValues, 1) To UBound(avntValues, 1)
If Not IsEmpty(avntValues(ialngIndex, 2)) Then
strFilename = avntValues(ialngIndex, 2) & "." & avntValues(ialngIndex, 40)
strOldPath = avntValues(ialngIndex, 36)
If Right$(strOldPath, 1)  "\" Then strOldPath = strOldPath & "\"
strNewPath = avntValues(ialngIndex, 35)
If Right$(strNewPath, 1)  "\" Then strNewPath = strNewPath & "\"
If Dir$(PathName:=strOldPath & strFilename)  vbNullString Then
If Dir$(PathName:=strNewPath & strFilename)  vbNullString Then
If MsgBox("Die Datei '" & strFilename & _
"' existiert bereits im Zielverzeichniss." & _
vbLf & vbLf & "Überschreiben?", vbQuestion Or _
vbYesNo, "Abfrage") = vbYes Then
Call Kill(PathName:=strNewPath & strFilename)
Call MoveFile(strOldPath, strNewPath, strFilename)
End If
Else
Call MoveFile(strOldPath, strNewPath, strFilename)
End If
Else
Call MsgBox("Die Datei '" & strFilename & _
"' wurde nicht gefunden.", vbExclamation, "Hinweis")
End If
End If
Next
End Sub
Private Sub MoveFile(ByVal pvstrOldPath As String, _
ByVal pvstrNewPath As String, pvstrFileName As String)
Dim lngReturnValue As Long
On Error GoTo err_exit
lngReturnValue = MoveFileA(pvstrOldPath & pvstrFileName, _
pvstrNewPath & pvstrFileName)
If lngReturnValue = 0 Then Call Err.Raise(Number:=1003, _
Description:="Verschieben fehlgeschlagen")
Exit Sub
err_exit:
Call MsgBox("Fehler: " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehlermeldung")
Resume Next
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Dateien Verschieben - Vorgaben in Tabellenblatt

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread