Word VBA сохранить файлы в новой папке

Question

У меня есть VBA в Word, который открывает несколько файлов из выбранной мной папки, заменяет логотип в заголовке новым файлом, на который я направляю его, а затем сохраняет файлы в другом папка.

У меня есть файлы, которые сохраняются в другой папке не потому, что я хочу, а потому, что они открываются как только для чтения, и я не могу понять, как это сделать. Я попробовал все, что мог найти здесь. Я в порядке с ними, сохраняя в новой папке. Это не проблема для меня прямо сейчас.

Прямо сейчас, этот код работает, но я должен нажать «Сохранить» для каждого документа. Я бы хотел, чтобы это было автоматизировано. Код прямо здесь: 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 

и включают FilePath так:

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

В новой версии Word, это изменение в SaveAs2 но SaveAs все еще работает.
Этот метод принимает путь к файлу, в котором вы хотите сохранить файл в качестве первого аргумента.