避免"另存为"使用VBA脚本将Excel转换为XML时的对话框

时间:2017-02-21 10:36:47

标签: excel vba excel-vba filepath

我正在尝试编写一个将excel文件转换为XML的VBA脚本。我使用Application.GetSaveAsFilename()函数获取文件名。但是这个功能打开了"另存为"对话框。我想取消对话框,以便每次运行代码时都不会提示用户手动单击“保存”。相反,应该在硬编码的位置静默生成XML。

代码:

Sub BasicRTE()
    Dim FileName As Variant
    Dim Sep As String
    Dim Ws As Worksheet
    Dim autoSetFileName As String
    Dim folderName As String
    Dim location As Integer

    ChDrive (Left(ThisWorkbook.Path, 1))
    ChDir ThisWorkbook.Path
    ChDir ".."
    ChDir "InputFiles"
    Application.SendKeys ("{ENTER}")
    FileName = Application.GetSaveAsFilename( _
      InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
      FileFilter:="Xml Files (*.xml),*.xml")
    location = InStrRev(FileName, "\", , vbTextCompare)
    folderName = Mid(FileName, 1, location - 1)        
    For Each Ws In ThisWorkbook.Worksheets
        If InStr(1, Ws.Name, "#", vbTextCompare) <> 1 Then
            ExportToMyXMLFile FName:=CStr(folderName & "\" & Ws.Name & ".xml"), Sep:=CStr(Sep), _
            AppendData:=False, Ws:=Ws
        End If
    Next
End Sub

1 个答案:

答案 0 :(得分:1)

您使用Application.GetSaveAsFilename的唯一方法就是获取InputFiles路径相对于ThisWorkbookfolderName的路径。操作系统已经提供了!以下更改应该有效(但我自己没有测试过):

' fileName = ...                 ' don't need this
' location = ...                 ' or this
folderName = ThisWorkbook.Path & "\..\InputFiles"   ' e.g., C:\Users\Foo\Documents\..\InputFiles

或者,如果你想要一个更干净的字符串,

Dim location as Long     ' Never use Integer unless you are calling Win32 or something else esoteric

' Don't need any of this unless later code relies on the current directory
' (which it shouldn't, for robustness).
'ChDrive (Left(ThisWorkbook.Path, 1))
'ChDir ThisWorkbook.Path
'ChDir ".."
'ChDir "InputFiles"
'Application.SendKeys ("{ENTER}")
'FileName = Application.GetSaveAsFilename( _
'  InitialFileName:=ThisWorkbook.Worksheets(1).Name, _
'  FileFilter:="Xml Files (*.xml),*.xml")
folderName = ThisWorkbook.Path
location = InStrRev(folderName, "\", , vbTextCompare)
folderName = Mid(folderName, 1, location) & "InputFiles"
For Each ws ...

InStrRev + Mid删除最后一个路径组件,就像..一样,然后& "InputFiles"InputFiles放在最后。

一个警告:ThisWorkbook.Path是一个新的未保存工作簿的空字符串。在使用上述内容之前,请确保您的工作簿已保存到磁盘。

修改另一个警告:您在制作文件名时直接使用ws.Name。但是,工作表名称可以包含文件名不能的文本。我可以命名工作表CON<foo>,但这些工作表在文件名中都不起作用。 Here's清理文件名的一个示例(Google快速结果 - 未经过测试)。但是,即使该示例似乎也未检查reserved names

保留名称:CON,PRN,AUX,NUL,COM1,COM2,COM3,COM4,COM5,COM6,COM7,COM8,COM9,LPT1,LPT2,LPT3,LPT4,LPT5,LPT6,LPT7,LPT8和每MS}的LPT9。