要复制的Excel VBA - >多重粘贴并从excel列重命名一个Windows文件

时间:2016-10-28 21:19:42

标签: excel vba excel-vba

在编程方面,我并不聪明。请多多包涵。

我在源位置c:\Source中有一个image.pdf文件。我想创建此文件的副本,并使用其他名称将其重命名为其他位置。但问题还没有结束。

我想执行此粘贴操作,让我们说一百次,并根据Excel列重命名所有文件。每天范围扩大或缩小。

例如

  

源文件名 - Image.Jpg
  来源位置 - C:\ Source \
  目标文件名 - D:\ Destination \
  目的地文件名 -

     

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

您是否可以通过输入源文件名和位置来为我提供代码和示例Excel文件来执行此操作?

请帮助我,因为我每天都花很多时间做这件事。如果您需要Excel样本表以供参考,请与我们联系。

1 个答案:

答案 0 :(得分:0)

试试这个。您必须添加引用Microsoft Scripting Runtime。你可以在“工具” - >下进行“参考”

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