Excelmacros能够在Win8.1上保存csv，但是不能在Win10上保存/运行
我如何修改下面的VBA代码，使其在Win10上工作？ 它在Win8.1上正常工作。 在我的Win10电脑上，它创build目录，但无法保存csv。
这段代码是我自己写的添加保存csvfunction到数据获取代码的附加部分（来源： http ： //investexcel.net ）。
下面是运行整个macros时收到的错误消息（在使Application.DisplayAlerts = True之后）
'16 .csdv'无法访问。 该文件可能已损坏，位于没有响应的服务器上，或只读。 （选项 – 重试/取消）
按下取消后得到这个错误：
运行时错误1004：应用程序定义的错误或对象定义的错误
按下debugging把我带到这部分代码（用黄色突出显示）
ActiveSheet.SaveAs Filename:=FName, _ FileFormat:=xlCSV, CreateBackup:=False 这是保存CSV的整个代码体。
Dim strName As String Dim strDirname, Path, strDefpath As String Dim FName As String On Error Resume Next ' If directory exist goto next line 'Now we check if export folder exists. If not then it gets created here If Len(Dir("Z:\MyBackfill\Extracts\", vbDirectory)) = 0 Then MkDir "Z:\MyBackfill\Extracts\" End If strDirname = Format(CStr(Now), "DDMMMYY") ' New directory name strDefpath = "Z:\MyBackfill\Extracts\" MkDir strDefpath & strDirname Path = strDefpath & strDirname & "\" 'create total string dt = Format(CStr(Now), "DDMMMYY HHMMSS") Worksheets("Data").Activate Range("G8").Select Range(Selection, Selection.End(xlDown)).Select Selection.NumberFormat = "dd-MM-yy HH:mm:ss" Columns("G:G").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Columns("G:G").Select Application.CutCopyMode = False With ActiveSheet lLastRow = .Columns("G:G").Cells(.Rows.Count, 1).End(xlUp).Row ReDim arrDate(1 To lLastRow) As Long ReDim arrTime(1 To lLastRow) As Double arrDateTimes = .Range("G1:G" & lLastRow).Value For lRow = LBound(arrDateTimes) To UBound(arrDateTimes) arrDate(lRow) = Int(arrDateTimes(lRow, 1)) arrTime(lRow) = arrDateTimes(lRow, 1) - arrDate(lRow) Next .Range("H1:H" & lLastRow).Value = WorksheetFunction.Transpose(arrDate) .Range("I1:I" & lLastRow).Value = WorksheetFunction.Transpose(arrTime) .Range("H1:H" & lLastRow).NumberFormat = "dd-mm-yy" .Range("I1:I" & lLastRow).NumberFormat = "hh:mm:ss" End With ' Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _ ' TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ ' Semicolon:=False, Comma:=True, Space:=True, Other:=False, FieldInfo:= _ ' Array(1, 2), TrailingMinusNumbers:=True Range("G8").Select Range(Selection, Selection.End(xlDown)).Select Selection.NumberFormat = "dd-MM-yy" Range("H8").Select Range(Selection, Selection.End(xlDown)).Select Selection.NumberFormat = "HH:mm:ss" Columns("H:I").Select Selection.Cut Columns("B:B").Select Selection.Insert Shift:=xlToRight Columns("Z:I").Select Selection.Delete Shift:=xlToLeft Range("B8").Select Range(Selection, Selection.End(xlDown)).Select Selection.NumberFormat = "dd-MM-yy" Range("C8").Select Range(Selection, Selection.End(xlDown)).Select Selection.NumberFormat = "HH:mm:ss" Range("A8").Select ActiveCell.FormulaR1C1 = "=Parameters!R[5]C[1]" Range("A8").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A8").Select Application.CutCopyMode = False 'Selection.AutoFill Destination:=Range("A8:A4520") Selection.AutoFill Destination:=Range("A8:A" & Range("B" & Rows.Count).End(xlUp).Row) 'Range("A8:A4520").Select Columns("G:G").Select Selection.Cut Columns("E:E").Select Selection.Insert Shift:=xlToRight Columns("D:D").Select Selection.Cut Columns("H:H").Select Selection.Insert Shift:=xlToRight Rows("1:7").Select Range("A7").Activate Selection.Delete Shift:=xlUp 'ADDING 59 to Seconds for correct backfill////////////////////////////////////////// Dim cell As Range For Each cell In Range("C1", Range("C1").End(xlDown)) cell.Value = Left$(cell.Value, 6) & "59" Next 'Filename = "GFill" & " " & DataSheet.Range("A1").Value & " " & dt & " " & "FROM" & "_" & DataSheet.Range("B1").Value & ".csv" Filename = "GFill" & " " & "NIFTY" & " " & dt & " " & "FROM" & "_" & DataSheet.Range("B1").Value & ".csv" FName = Path & Filename Cells.Select Selection.Copy Workbooks.Add ActiveSheet.Paste Application.CutCopyMode = False 'ChDir "C:\Users\Vaibhav\Desktop" ActiveSheet.SaveAs Filename:=FName, _ FileFormat:=xlCSV, CreateBackup:=False ActiveWorkbook.Save ActiveWindow.Close Selection.QueryTable.Delete Selection.ClearContents Range("A1").Select ActiveWorkbook.Save
这有点棘手。
MkDir函数不能同时创build一个Drive:\Directory\Subdirectory – 它试图在一个不存在的目录中创build子目录，所以你首先必须创build目录， 然后你可以使用它来创build子目录：
MkDir "Drive:\Directory" MkDir "Drive:\Directory\Subdirectory"
所以这很可能解释了为什么即使在Win10机器的C驱动器上也出现故障。
对于Z＆E驱动器（假设这些是共享），如果您没有权限访问或写入Win10机器的驱动器，则会发生类似的错误; 这不是一个可以用VBA解决的问题，除非它是一个简单的驱动器盘符映射问题，在这种情况下，您可以通过提供完整的规范path来解决它，例如：
MkDir "\\servername\Directory"
由于您仍然在SaveAs上发生错误，请检查Fname的值。
您从以下位置获取date值：
DataSheet.Range("B1").Value
这包括不能在文件名中使用的正斜杠字符。
改为：
Format(DataSheet.Range("B1").Value, "yyyymmdd")
感谢David Zemens。
他指出我使用即时窗口。
问题出现了，因为某些原因，“/”出现在文件名中，而不是。
适当编辑FileNamevariables以删除“/”，文件正在正确生成。
只是要注意，这个相同的问题是不是在win8.1