从Excel的单个单元格复制名称，并使用VBA为每个名称创建/保存新的Word文档

Question

给定一个未指定列表的excel电子表格A列中的名称，我想为列表中的每个单独名称创建多个word文档。 我还希望每个名称都成为doc一词的名称，后跟今天的日期，即Michael_03232017.docx

我查找了类似问题的示例，但是由于我还是一个初学者，它们都有些复杂。 除了设置需要迭代的单元格范围外，我在入门时遇到了麻烦。

这是我开始的：

Sub WordDocTransf()
    Dim Rng As Range
    Dim wdAPP As Object
    Dim wdDoc As Object

    set Rng = Worksheets("Sheet1").Range("A1:A" & Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A".End(xlup).Row)

End Sub

我不知道如何实现wdAPP和wdDoc对象。 请开始使用时需要一些帮助。 谢谢！

Answer 1

我已经测试过，这将创建指定的文件。 我留给您研究如何实际填充Word文档。

Sub WordDocTransf()
    Dim dateStr As String
    Dim Rng As Range
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim lastRow As Long

    lastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1
    Set Rng = ActiveSheet.Range("A1:A" & lastRow)

    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True

    For Each cell In Rng
        Set wrdDoc = wrdApp.Documents.Add

        dateStr = "_" & Format(Month(Date), "00") & Format(Day(Date), "00") & CStr(Year(Date))

        With wrdDoc
            If Dir("C:\your_folder\" & cell.Value & dateStr & ".doc") <> "" Then
                Kill "C:\your_folder\" & cell.Value & dateStr & ".doc"
            End If
            .SaveAs ("C:\your_folder\" & cell.Value & dateStr & ".doc")
            .Close
        End With
    Next
    wrdApp.Quit
    Set wrdDoc = Nothing
    Set wrdApp = Nothing
End Sub