VBA 自动保存文件

Posted 2023-05-07

【中文标题】VBA 自动保存文件

【英文标题】：VBA automatically saving files

【发布时间】：2015-04-22 07:40:44

【问题描述】：

我正在尝试自动将文件保存在指定文件夹中。 比如有ResultTest1、ResultTest2、ResultTest3等等。

Dim savedName As String
Dim arNames() As String
Dim myCount As Integer

savedName = Dir$("D:\Users\tmp4jj\Desktop\ComparisonTool\ResultTest*.docx")
Do Until savedName = ""
    myCount = myCount + 1
    ReDim Preserve arNames(1 To myCount)
    arNames(myCount) = savedName
    savedName = Dir$
Loop

我一直在尝试这段代码，但我不确定它是否真的有效。另外，我尝试录制一个宏，在该宏中我事先更改了保存文件目标的选项。这些代码弹出，不确定是否有帮助。

ActiveDocument.SaveAs2 FileName:="ResultTest.docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14

【问题讨论】：

什么时候应该保存文件？，如果您只需要在目录中查找文件，您会在这里找到许多解决方案，例如使用Scripting com ;)。

除了一个文本比较宏之外，我还使用它来比较两个文件，并在一个新的 Word 文档中创建一个额外的“结果”文件。我想将这些结果文件保存在指定的文件夹中。

Loop comparison macro 的可能重复项

【参考方案1】：

如果您想处理具有某些功能的文件，我建议您使用FileSystemObject com object。

在项目中有很多使用它的例子：

Get content of the directory using wildcast with FileSystemObject How can I use the FileSystemObject to “Copy and rename”

您还可以在循环中使用like 运算符来查找文件 -in (1) sample-;像这样：

IF (f1.name like "ResultTest*.docx") THEN
    ' Write your code here
END IF

---

Source

On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Getting file name by default input window
Flname = InputBox("Enter File Name :", "Creating New File...")
If Flname <> "" Then

    ' adding a new workbook
    Set NewWkbk = Workbooks.Add

    ' Copy data from a sheet (e.g 5) from current workbook to a sheet (e.g 1) in that new one
    ThisWorkbook.Sheets(5).Copy Before:=NewWkbk.Sheets(1)

    ' Create excel file by saving the new workbook as file name
    NewWkbk.SaveAs ThisWorkbook.Path & "\" & Flname

    If Err.Number = 1004 Then
        NewWkbk.Close
        MsgBox "File Name Not Valid."
        Exit Sub
    End If
End If

【讨论】：

不确定我是否正确...但是 FileSystemObject 从特定文件夹/驱动器获取文件对吗？我想要做的是将文件保存到特定的文件夹/驱动器中。因此，这些文件还不存在，我认为 FileSystemObject 不会工作？不过我对此很陌生，所以我可能错了。

@JunJie 哦！，所以你想用你的结果制作一个新的 Excel 文件？我添加一个解决方案 ;)。