2016-10-28 5 views
-2

Ich bin nicht so schlau, wenn es um die Programmierung geht. Bitte bei mir tragen.Excel VBA zu kopieren -> mehrere einfügen und eine Windows-Datei aus einer Excel-Spalte umbenennen

Ich habe eine image.pdf-Datei in einer Quelle c:\Source. Ich möchte eine Kopie dieser Datei erstellen und sie an einem anderen Ort unter einem anderen Namen umbenennen. Aber die Frage ist nicht drüber.

Ich möchte diese einfügen Operation für sagen wir hundert Mal und benennen Sie alle Dateien auf der Grundlage einer Excel-Spalte. Jeden Tag dehnt sich das Angebot aus oder schrumpft.

Für Beispiel

Quelle Dateiname - Image.jpg
Source Location - C: \ Source \
Zieldateiname - D: \ Ziel \
Zieldateinamen -

Alpha.Jpg
Beta.Jpg
.
.
.
.
Zebra.Jpg

Könnten Sie mir bitte mit einem Code und Beispiel Excel-Datei zur Verfügung stellen dies auszuführen, indem nur die Quell- und Zieldateinamen und Orte eingeben?

Bitte helfen Sie mir, da ich eine Menge Zeit damit verbracht habe, dies jeden Tag zu tun. Bitte lassen Sie mich wissen, wenn Sie eine Beispiel-Excel-Tabelle als Referenz benötigen.

+1

Wir Beispielcode nicht auf SO liefern, wenn Sie es selbst versucht haben, und haben Probleme mit ihm – techydesigner

Antwort

0

Versuchen Sie dies. Sie müssen die Referenz Microsoft Scripting Runtime hinzufügen. Sie tun es unter „Extras“ -> „Referenzen“

Option Explicit 

Sub CreateCopies(ByVal destPath As String, ByVal templateFullPathName As String) 

Dim fso As Scripting.FileSystemObject 
Dim aName As Variant 
Dim wks As Worksheet 
Dim myDest As String 
Dim lastRow As Long, iCell As Long 

Set fso = New Scripting.FileSystemObject 

Set wks = ThisWorkbook.Sheets("Sheet1") 

' Find last row in column A 
lastRow = wks.Range("A" & wks.Rows.Count).End(xlUp).Row 

' Loop through cells from last row to 2nd row (if 1st row is header) 
For iCell = lastRow To 2 Step -1 

    aName = Cells(iCell, 2).Value 

    myDest = destPath & "\" & "Copy of " & aName & ".pdf" 

    fso.CopyFile _ 
     Source:=templateFullPathName, _ 
     Destination:=myDest 

Next iCell 

If Not (fso Is Nothing) Then Set fso = Nothing 
End Sub 


Sub UseThisToCallProcedure() 
Call CreateCopies("D:\Destination\", "C:\Source\FILETOCOPY.pdf") 
End Sub 
+0

Danke. Ich habe vergessen zurück zu antworten. –

+0

@MansoorKhader Bitte akzeptieren Sie es als Antwort. – Niclas

Verwandte Themen