我用VBA构建了一个Excel文件，您可以在其中生成目录并将正确的文档（Word和Excel文件）直接放入正确的目录中。因此，当您执行代码（在Excel中）时，首先必须选择您的Root-Destination，然后创建所有目录。之后，它从Templatefolder获取Worddocuments，用Excel中的Data填充Textmarks并保存文件。这很有效，也要感谢这个社区。
但是现在的问题是：我无法使其工作，而是要在word文档的页脚中填写新的文件名。
这是目前完整功能的代码：
Public Function Txtmkr_SDD()
Dim appWord As Object 'Word-Instance
Dim wdDoc As Object 'Word-Document
Dim wdRngE As Object 'Word-Range 1
Dim wdRngR As Object 'Word-Range 2
Dim wdRngC As Object 'Word-Range 3
Dim wdRngCN As Object 'Word-Range 4
Dim wks As Worksheet 'Excel-Worksheet
Dim AdresseCE As String
Dim neueAdresseCE As Long
Dim Processname1 As String
Dim Processname2 As String
Dim Version As String
'*** Word start ***
Set appWord = CreateObject("Word.Application")
'*** opens File ***
Set wdDoc = appWord.Documents.Add(Template:=Worksheets("StartPage").Cells(48, 4) & "\Document_Templates\SDD_Template.dotx", NewTemplate:=False, DocumentType:=0)
'*** Word visible ***
appWord.Visible = True
'*** just in case Document is protected ***
'doc.Unprotect
'*** Jump to Textmarker in Word ***
'*** Check of existence ***
'*** Take Value from "CopyData" Cell "B1" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname1") Then
With wdDoc.Bookmarks("Processname1")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(1, 2).Value
wdDoc.Bookmarks.Add "Processname1", wdRngE
End With
Else
MsgBox "Missing Link [Processname1]."
End If
'*** Take Value from "CopyData" Cell "B2" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname2") Then
With wdDoc.Bookmarks("Processname2")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(2, 2).Value
wdDoc.Bookmarks.Add "Processname2", wdRngE
End With
Else
MsgBox "Missing Link [Processname2]."
End If
If wdDoc.Bookmarks.Exists("Version") Then
With wdDoc.Bookmarks("Version")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(3, 2).Value
wdDoc.Bookmarks.Add "Version", wdRngE
End With
Else
MsgBox "Missing Link [Version]."
End If
If wdDoc.Bookmarks.Exists("Create_Date") Then
With wdDoc.Bookmarks("Create_Date")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(4, 2).Value
wdDoc.Bookmarks.Add "Create_Date", wdRngE
End With
Else
MsgBox "Missing Link [Create_Date]."
End If
If wdDoc.Bookmarks.Exists("Author") Then
With wdDoc.Bookmarks("Author")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(6, 2).Value
wdDoc.Bookmarks.Add "Author", wdRngE
End With
Else
MsgBox "Missing Link [Author]."
End If
'*** Set Time_Date and SDD Path ***
Dim time_date As String
time_date = Format(Date, "yyyy_mm_dd")
Dim SDD As String
'*** Define SDD as RegularPath ***
SDD = (time_date & "_" & Worksheets("CopyData").Cells(1, 2).Value & "_" & Worksheets("CopyData").Cells(21, 2).Value & "_" & Worksheets("Helper#3").Cells(3, 2).Value & "_" & "V" & Worksheets("CopyData").Cells(3, 2).Value & ".docx")
'*** Dim wdApp As Word.Application ***
Set wdApp = GetObject(, "Word.Application")
'*** Set up SavePath & Filename ***
appWord.ActiveDocument.SaveAs Worksheets("Variables").Cells(3, 8).Value & "\" & (Worksheets("Setup#2_DirectoryList").Cells(1, 1)) & "\" & Worksheets("Setup#2_DirectoryList").Cells(3, 3).Value & "\" & Worksheets("Setup#2_DirectoryList").Cells(14, 21).Value & "\" & SDD
'*** Word quit ***
appWord.ActiveDocument.Close
appWord.Quit
'*** disable Variables ***
Set wdRngE = Nothing
Set wdRngR = Nothing
Set wdRngC = Nothing
Set wdRngCN = Nothing
Set wdRng = Nothing
Set wdDoc = Nothing
Set appWord = Nothing
Set sFolder = Nothing
End Function
如果有人可以帮助我，那将是很棒的：-）
答案 0 :(得分：0)
只需将FILENAME字段放在模板的页脚中。这样，您不需要代码即可完成相同的操作。相反，您需要做的所有事情（保存文件后）都使用：
Application.ScreenUpdating = False
With ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
然后重新保存以使字段更新为“ stick”。
答案 1 :(得分：0)
感谢 marcroprod ，该问题已解决。 对于遇到类似问题的每个人，下面是完整的代码：
Public Function Txtmkr_SDD()
Dim appWord As Object 'Word-Instance
Dim wdDoc As Object 'Word-Document
Dim wdRngE As Object 'Word-Range 1
Dim wdRngR As Object 'Word-Range 2
Dim wdRngC As Object 'Word-Range 3
Dim wdRngCN As Object 'Word-Range 4
Dim wks As Worksheet 'Excel-Worksheet
Dim AdresseCE As String
Dim neueAdresseCE As Long
Dim Processname1 As String
Dim Processname2 As String
Dim Version As String
'*** Word start ***
Set appWord = CreateObject("Word.Application")
'*** opens File ***
Set wdDoc = appWord.Documents.Add(Template:=Worksheets("StartPage").Cells(48, 4) & "\Document_Templates\SDD_Template.dotx", NewTemplate:=False, DocumentType:=0)
'*** Word visible ***
appWord.Visible = True
'*** just in case Document is protected ***
'doc.Unprotect
'*** Jump to Textmarker in Word ***
'*** Check of existence ***
'*** Take Value from "CopyData" Cell "B1" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname1") Then
With wdDoc.Bookmarks("Processname1")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(1, 2).Value
wdDoc.Bookmarks.Add "Processname1", wdRngE
End With
Else
MsgBox "Missing Link [Processname1]."
End If
'*** Take Value from "CopyData" Cell "B2" and insert Textmarker ***
If wdDoc.Bookmarks.Exists("Processname2") Then
With wdDoc.Bookmarks("Processname2")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(2, 2).Value
wdDoc.Bookmarks.Add "Processname2", wdRngE
End With
Else
MsgBox "Missing Link [Processname2]."
End If
If wdDoc.Bookmarks.Exists("Version") Then
With wdDoc.Bookmarks("Version")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(3, 2).Value
wdDoc.Bookmarks.Add "Version", wdRngE
End With
Else
MsgBox "Missing Link [Version]."
End If
If wdDoc.Bookmarks.Exists("Create_Date") Then
With wdDoc.Bookmarks("Create_Date")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(4, 2).Value
wdDoc.Bookmarks.Add "Create_Date", wdRngE
End With
Else
MsgBox "Missing Link [Create_Date]."
End If
If wdDoc.Bookmarks.Exists("Author") Then
With wdDoc.Bookmarks("Author")
Set wdRngE = .Range
wdRngE.Text = Worksheets("CopyData").Cells(6, 2).Value
wdDoc.Bookmarks.Add "Author", wdRngE
End With
Else
MsgBox "Missing Link [Author]."
End If
'*** Set Time_Date and SDD Path ***
Dim time_date As String
time_date = Format(Date, "yyyy_mm_dd")
Dim SDD As String
'*** Define SDD as RegularPath ***
SDD = (time_date & "_" & Worksheets("CopyData").Cells(1, 2).Value & "_" & Worksheets("CopyData").Cells(21, 2).Value & "_" & Worksheets("Helper#3").Cells(3, 2).Value & "_" & "V" & Worksheets("CopyData").Cells(3, 2).Value & ".docx")
'*** Dim wdApp As Word.Application ***
Set wdApp = GetObject(, "Word.Application")
'*** Set up SavePath & Filename ***
appWord.ActiveDocument.SaveAs Worksheets("Variables").Cells(3, 8).Value & "\" & (Worksheets("Setup#2_DirectoryList").Cells(1, 1)) & "\" & Worksheets("Setup#2_DirectoryList").Cells(3, 3).Value & "\" & Worksheets("Setup#2_DirectoryList").Cells(14, 21).Value & "\" & SDD
'*** Updating the Footer of the Document ***
Application.ScreenUpdating = False
With appWord.ActiveDocument
.Fields.Update
.PrintPreview
.ClosePrintPreview
End With
Application.ScreenUpdating = True
appWord.ActiveDocument.Save
'*** Word quit ***
appWord.ActiveDocument.Close
appWord.Quit
'*** disable Variables ***
Set wdRngE = Nothing
Set wdRngR = Nothing
Set wdRngC = Nothing
Set wdRngCN = Nothing
Set wdRng = Nothing
Set wdDoc = Nothing
Set appWord = Nothing
Set sFolder = Nothing
End Function