复制Excel单元格，评估内容，并复制循环单元格内容的文件作为文件名

我已经添加了一个额外的图像。 DocType列自动从“Doc Types”表格复制到此表单中。 内容可以改变，并在多less个单元格填写的范围。 所以公式创build第一列，我需要VB然后评估文件path列的结果并复制"C:\test\images\tester.TIF"多less次必要的文件path在那里创build的文件path。 我目前所使用的代码要简单得多，但我不知道这个方向。

     Sub CopyEmTWO（）
        昏暗的ws作为工作表
        昏暗的strIn作为string
         Dim strOut As String
         Dim strFile As String
        昏暗的strLPart作为string
         Dim strRPart As String
        昏暗lngCnt作为string
         Dim lngFiles As Long
        设置ws =表格（“捷运”）
         lngCnt = Application.CountA（ws.Columns（“A”））
        如果lngCnt = 0然后退出子
         strIn =“C：\ inserver6 \ script \ Toolbelt \ MRTesting \”
         strOut =“C：\ inserver6 \ script \ Toolbelt \ MRTesting \”
         strFile =“MRTesting.tif”
         '提取文件名称的string部分并在复制循环外键入
         strLPart = Left $（strFile，InStr（strFile，“。”） -  1）
         strRPart = Right $（strFile，Len（strFile） -  Len（strLPart））
        对于lngFiles = 1到lngCnt
             FileCopy strIn＆strFile，strOut＆strLPart＆“（”＆lngFiles＆“）”＆strRPart
        下一个
    结束小组

我仍然是一个新手，我已经采取了8小时的刺伤，不能正确的。 这是我简单枚举和复制的工作代码。 如果需要完全不同的方法，请提供您的想法。 提前致谢。

Answer 1

如果我正确理解input（屏幕是非常有用的），下面的一段代码将完成这项工作：

 Sub CloneImage() Dim SampleFile As String Dim SampleFileExt As String Dim OutputFolder As String Dim ResultFile As String Dim CurrentName As String Dim FSO As Object Dim i As Long Dim CopyCount As Long SampleFile = "D:\DOCUMENTS\1.gif" OutputFolder = "D:\DOCUMENTS\1\" Set FSO = CreateObject("Scripting.FileSystemObject") CopyCount = 0 Application.ScreenUpdating = False If FSO.FileExists(SampleFile) = True Then SampleFileExt = "." & FSO.GetExtensionName(SampleFile) Else MsgBox "Source file:" & vbNewLine & SampleFile & vbNewLine & "does not exist!" Exit Sub End If If FSO.FolderExists(OutputFolder) = False Then FSO.CreateFolder OutputFolder For i = 2 To ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Rows.Count CurrentName = ThisWorkbook.ActiveSheet.Cells(i, 1).Value ResultFile = OutputFolder & CurrentName & SampleFileExt ThisWorkbook.ActiveSheet.Cells(i, 2).Formula = ResultFile ThisWorkbook.ActiveSheet.Cells(i, 3).Formula = CurrentName & ": " & ResultFile If FSO.FileExists(ResultFile) = False Then FSO.CopyFile SampleFile, ResultFile CopyCount = CopyCount + 1 Else MsgBox "Destination file:" & vbNewLine & ResultFile & vbNewLine & "already exists!" End If Next i ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Columns.AutoFit Application.ScreenUpdating = True Set FSO = Nothing MsgBox i - 2 & " string(s) processed," & vbNewLine & CopyCount & " file(s) created in:" & vbNewLine & OutputFolder End Sub 

假设和限制：

1. 将警告关于丢失的源文件。
2. 文件扩展名将从源文件中获取。
3. 输出文件夹将自动创build（如果不存在）。
4. 会警告已经存在的目标文件。
5. 包含string/文件数量的最终消息处理。

示例文件也是共享的： https ： //www.dropbox.com/s/jhbkwzuxzt01kzs/CloneImage.xlsm

希望有帮助。