Word VBA 在新文件夹中保存文件

Question

我在 Word 中有 VBA，它可以从我 select 的文件夹中打开多个文件，用我指向的新文件替换 header 中的徽标，然后然后将文件保存在不同的文件夹中。

我将文件保存在不同的文件夹中不是因为我想这样做，而是因为它们以 read-only 打开，我不知道如何避免这种情况发生。我已经尝试了在这里可以找到的所有内容。我同意他们保存到新文件夹。现在对我来说这不是问题。

现在，此代码有效，但我必须为每个文档单击 "Save"。我希望它是自动化的。此处的代码是 saveas

End With
With Dialogs(wdDialogFileSaveAs)
.Name = "\i-worx-san-07.i-worx.ca\wardell$\Redirection\billy.bones\Desktop\Test 3\" & ActiveDocument.Name
.Show
End With

End With
objDocument.SaveAs
objDocument.Close (True)

以下是完整的VBA代码。我是一个绝对的新手，所以放轻松。我想知道如何让 saveas 包含原始文件名、一个新的指定文件夹（可以在代码中指定，不必由用户指定）并且无需用户按 "save" 巴西亿次。感谢您的帮助。

Sub Example1()
'Declaring the required variables
Dim intResult As Integer
Dim strPath As String
Dim arrFiles() As String
Dim i As Integer
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
'dispaly message box
strPath = Application.FileDialog( _
    msoFileDialogFolderPicker).SelectedItems(1)
    'Get all the files paths and store it in an array
arrFiles() = GetAllFilePaths(strPath)
'Modifying all the files in the array path
For i = LBound(arrFiles) To UBound(arrFiles)
    Call ModifyFile(arrFiles(i))
Next i
End If
End Sub

Private Sub ModifyFile(ByVal strPath As String)
Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
With ActiveDocument.Sections(1)
With ActiveDocument.Sections(1)
.Headers(WdHeaderFooterIndex.wdHeaderFooterPrimary).Range.Delete
End With
    Dim imagePath As String
    'Please enter the relative path of the image here
    imagePath = "C://FILEPATH\FILENAME.jpg"
   Set oLogo = .Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(FileName:=imagePath, LinkToFile:=False, SaveWithDocument:=True)
    With oLogo.Range
       .ParagraphFormat.Alignment = wdAlignParagraphRight
       'Right alignment for logo image
       .ParagraphFormat.RightIndent = InchesToPoints(-0.6)
    End With
End With
With oLogo
    .Height = 320
    .Width = 277

With Selection.PageSetup
    'Header from Top value
    .HeaderDistance = InchesToPoints(0.5)
End With
With Dialogs(wdDialogFileSaveAs)
.Name = "\i-worx-san-07.i-worx.ca\wardell$\Redirection\billy.bones\Desktop\Test 3\" & ActiveDocument.Name
.Show
End With

End With
objDocument.SaveAs
objDocument.Close (True)
End Sub
Private Function GetAllFilePaths(ByVal strPath As String) _
As String()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim arrOutput() As String
ReDim arrOutput(1 To 1)
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(strPath)
i = 1
'loops through each file in the directory and
'prints their names and path
For Each objFile In objFolder.Files
ReDim Preserve arrOutput(1 To i)
'print file path
arrOutput(i) = objFile.Path
i = i + 1
Next objFile
GetAllFilePaths = arrOutput
End Function

Answer 1

删除调用 FileSaveAs 对话的这一行。

With Dialogs(wdDialogFileSaveAs)
    .Name = "\i-worx-san-07.i-worx.ca\wardell$\Redirection\billy.bones\Desktop\Test 3\" & ActiveDocument.Name
    .Show
End With

然后修改这一行：

objDocument.SaveAs

并像这样包含文件路径：

objDocument.SaveAs "\i-worx-san-07.i-worx.ca\wardell$\Redirection\" _
    & "billy.bones\Desktop\Test 3\" & ActiveDocument.Name

在较新版本的 Word 中，它已更改为 SaveAs2，但 SaveAs 仍然有效。
该方法采用您希望将文件保存为第一个参数的文件路径。

Word VBA 在新文件夹中保存文件

Word VBA save files in new folder

vba

ms-word