Question

我在Word中使用VBA从我选择的文件夹中打开多个文件，用我引导它的新文件替换标题中的徽标，然后将文件保存在不同的文件夹中。

我将文件保存在不同的文件夹中并不是因为我想要，而是因为它们以只读方式打开，我无法弄清楚如何使其不会发生。我已经尝试了我能在这里找到的一切。我很好，他们保存到一个新的文件夹。这对我来说不是问题。

现在，此代码有效，但我必须为每个文档单击“保存”。我希望这是自动化的。这里的代码是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包括原始文件名，一个新的指定文件夹（可以在代码中指定，不必由用户指定）并且无需用户必须按“保存” “无数次。感谢您的帮助。

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将文件保存在新文件夹中

1 个答案: