我编写了一个简单的宏,用于将所有工作簿保存为单独的CSV文件。 这在我的本地机器(英语Lang)上适用于* D:\ MyFolder * 等路径。
但是当我在另一台启用了日语的Windows机器上尝试相同的宏时,SaveAS
方法会出现1004错误。
文件路径如 D:¥MyFolder¥
以下是导致错误的我的代码:
pathSeperator = Application.PathSeparator
strPath = InputBox(“输入现有的目录路径,如 d:\ someDirectoryName,d:“,,, 1000)
SaveToDirectory = strPath & pathSeperator & "csv" & pathSeperator If Dir(strPath & pathSeperator & "csv", vbDirectory) = "" Then fso.CreateFolder SaveToDirectory Else fso.DeleteFolder strPath & pathSeperator & "csv" fso.CreateFolder SaveToDirectory End If For Each WS In ThisWorkbook.Worksheets newName = WS.Name & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hhmmss") WS.Copy ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSVMSDOS, Local:=True ActiveWorkbook.Close Savechanges:=False Next
答案 0 :(得分:1)
在日语机器上,您是否尝试将visual basic编辑器上的字体更改为日文字体?
可以通过工具>选项 - >格式标签来完成。
编辑2013年8月22日
有点远,但我读过ASCII中的日元字符与英语机器上的/ charcter相同,因此使用Chr(92)应该可以兼用。在英语机器上它会显示为/日本机器上它将具有日元符号。一个简单的测试是在日本机器上运行以下宏,看看会发生什么。
Sub TestSeperator()
MsgBox Chr(92)
End Sub
如果是这种情况,那么您需要进行如下更改:
SaveToDirectory = strPath & Chr(92) & "csv" & Chr(92)
If Dir(strPath & Chr(92) & "csv", vbDirectory) = "" Then
fso.CreateFolder SaveToDirectory
Else
fso.DeleteFolder strPath & chr(92) & "csv"
fso.CreateFolder SaveToDirectory
答案 1 :(得分:0)
我在我的英语语言机器上试用了你的代码,并在我进入目录路径时设法引发了1004错误,包括最后的“\”
我修改了代码,以便它添加路径分隔符(如果它不存在),其余代码假定它已经在strPath中。
pathSeperator = Application.PathSeparator
strPath = InputBox("Enter EXISTING Directory path like d:\someDirectoryName, d:", , , 1000)
Set fso = New FileSystemObject
If Right(strPath, 1) <> pathSeperator Then 'added if clause
strPath = strPath & pathSeperator
End If
SaveToDirectory = strPath & "csv" & pathSeperator 'Removed one pathSeperator
If Dir(strPath & pathSeperator & "csv", vbDirectory) = "" Then
fso.CreateFolder SaveToDirectory
Else
fso.DeleteFolder strPath & "csv" 'Removed one pathSeperator
fso.CreateFolder SaveToDirectory
End If
For Each WS In ThisWorkbook.Worksheets
newName = WS.Name & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Time, "hhmmss")
WS.Copy
ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSVMSDOS, Local:=True
ActiveWorkbook.Close Savechanges:=False
Next