2017-02-21 58 views
0

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

ExportToMyXMLFile的代码是什么? –

+0

@Mark对不起,没有包含ExportToMyXml的代码,因为那部分代码没有任何问题,所以认为它是无关紧要的。 –

回答

1

看来,您正在使用Application.GetSaveAsFilename的唯一一件事就是让路径InputFiles路径相对于的ThisWorkbook位置到folderName。操作系统已经提供了!下面的变化应该工作(但我没有测试他们自己):

' 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)。

+0

该工作簿将被预先保存,因为这将用于我的自动化框架中,所以使用ThisWorkbook.path不是问题。此外,图纸名称是预定义的,所以不太可能成为保留名称。代码像魅力一样工作。 谢谢! –