我为此添加了一个附加图像。DocType列会从"Doc类型"工作表自动复制到此工作表中。内容可以更改,填写的单元格数量也可以更改。因此,公式创建第一列,我需要vb来评估文件路径列的结果,并将"C:\test\image\test. TIF"
复制到在那里创建的文件路径需要多少次。我目前拥有的下面的代码要简单得多,但我不知道该朝哪个方向发展。
Sub CopyEmTWO() Dim ws As Worksheet Dim strIn As String Dim strOut As String Dim strFile As String Dim strLPart As String Dim strRPart As String Dim lngCnt As String Dim lngFiles As Long Set ws = Sheets("MRT") lngCnt = Application.CountA(ws.Columns("A")) If lngCnt = 0 Then Exit Sub strIn = "C:\inserver6\script\Toolbelt\MRTesting\" strOut = "C:\inserver6\script\Toolbelt\MRTesting\" strFile = "MRTesting.tif" 'extract string portions of the file name and type outside the copy loop strLPart = Left$(strFile, InStr(strFile, ".") - 1) strRPart = Right$(strFile, Len(strFile) - Len(strLPart)) For lngFiles = 1 To lngCnt FileCopy strIn & strFile, strOut & strLPart & "(" & lngFiles & ")" & strRPart Next End Sub
我还是个新手,我已经尝试了8个小时,但还是做不到。这是我简单枚举和复制的工作代码。如果它需要一个完全不同的方法,请提供你的任何想法。提前感谢。
如果我正确理解输入(屏幕非常有帮助),以下代码将完成这项工作:
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
假设
示例文件也被共享:https://www.dropbox.com/s/jhbkwzuxzt01kzs/CloneImage.xlsm
希望这是有帮助的。