基于单元格值复制word文档的宏会抛出下标错误

时间:2018-01-02 16:30:05

标签: vba excel-vba excel

你好,新年快乐, 我试图重建一个我在过去一年里迷失的宏。我每年只使用一次这个宏,因为这是新的一年重新开始工作的第一天 - 我需要宏观,而且无法找到它。

宏需要做的是使用范围中每个单元格的值作为文件名创建word文件的副本。 (文件名实际上是一年中的每个星期一。)

我得到了

  

错误9:下标超出范围

我无法找到问题 - 路径和文件名有效 - 任何人都可以看到我忽略的内容?或者我应该以不同的方式处理这项任务?

提前致谢 史蒂夫

Sub batch_minutesbuilder()
 On Error GoTo errHndl
 Dim wb As Workbook
 Dim ws As Worksheet

 'word declaration
 Dim wdApp As Word.Application
 Dim wdDoc As Word.document
 Dim sel As Word.Selection

 'set the excel workbook and worksheets
 Set wb = ThisWorkbook
 Set ws = wb.Worksheets("MinutesTemplate")



 Dim fso As Object
 'Dim fld As Folder
 Dim sourcePath As String, destPath As String
 Dim sourceFile As String, destFile As String, sourceExtension As String
 Dim rng As Range, cell As Range, row As Range




 Set fso = CreateObject("Scripting.FileSystemObject")
 ' Set rng = ThisWorkbook.ActiveSheet.Range("D2", "D53")
 Set rng = ws.Range("D2:D53").Value


 'Uncomment for testing
 MsgBox rng

 sourcePath = "C:\SLC\"

 'Uncomment for testing
 MsgBox sourcePath

 destPath = "C:\SLC\"

 'Uncomment for testing
 MsgBox destPath

 sourceFile = "MinTemplate.docx"

 'Uncomment for testing
 MsgBox sourceFile

 destFile = ""



 For Each row In rng.Rows
     sourceExtension = VBA.Split(VBA.Trim(row.Cells(, 2)), ".")(1)
      MsgBox sourceExtension
     sourceFile = sourcePath & "MinTemplate.docx"
     MsgBox sourceFile

     destFile = destPath & VBA.Trim(row.Cells(, 1)) & "." & sourceExtension
     MsgBox destFile

     fso.CopyFile sourceFile, destFile, False
 Next row

 MsgBox "Yay! Operation was successful.", vbOKOnly + vbInformation, "Done"
 Exit Sub

 errHndl:
 MsgBox "Error happened while working on: " + vbCrLf + _
     sourceFile + vbCrLf + vbCrLf + "Error " + _
     Str(Err.Number) + ": " + Err.Description, vbCritical + vbOKOnly, 
 "Error"

End Sub

0 个答案:

没有答案