【发布时间】：2015-03-26 07:19:37
【问题描述】：
我在 Word 中有 VBA，它从我选择的文件夹中打开多个文件，将标题中的徽标替换为我将其定向到的新文件，然后将文件保存在不同的文件夹中。
我将文件保存在不同的文件夹中不是因为我想要，而是因为它们以只读方式打开，我不知道如何使这种情况不发生。我已经尝试了在这里能找到的一切。我对他们保存到一个新文件夹很好。这不是我现在的问题。
现在，此代码有效，但我必须为每个文档单击“保存”。我希望它是自动化的。这里的代码是另存为
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
【问题讨论】：
-
我很惊讶
imagePath = "C://FILEPATH\FILENAME.jpg"为你工作。您可以在所有 Sub 的顶部预设Const FDR1 = "\\Server\Folder"等文件夹。您还有一种低效的方法来获取文件夹中的文件列表。您是否忽略了子文件夹中的文件？ -
已由 L42 解决 非常感谢！