Excel 宏能够在 Win8.1 上保存 csv 但在 Win10 上停止保存/工作答案

【问题标题】：Excel Macro able to save csv on Win8.1 but stopped saving / working on Win10Excel 宏能够在 Win8.1 上保存 csv 但在 Win10 上停止保存/工作
【发布时间】：2016-06-30 13:06:29
【问题描述】：

如何修改以下 VBA 代码以使其在 Win10 上运行？它在Win8.1上运行良好。在我的 Win10 电脑上，它会创建目录但无法保存 csv。

此代码是我自己编写的附加部分，将保存 csv 功能添加到数据获取代码（来源：http://investexcel.net）。

以下是我在运行整个宏时收到的错误消息（在使 Application.DisplayAlerts = True 之后）

“16.csdv”无法访问。该文件可能已损坏、位于没有响应的服务器上或只读。（选项 - 重试/取消）

按取消后出现此错误：

运行时错误 1004：应用程序定义或对象定义错误

按调试键将我带到这部分代码（以黄色突出显示）

    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

【问题讨论】：

您是否收到任何错误消息？如果有，在哪里？
抱歉，现在将错误行添加到主要问题正文。请稍等片刻。
而 哪一行 引发了错误？
那么你的 Win 10 PC 没有 Z 共享的写权限。
不，这似乎不是操作系统问题，它似乎是机器/权限问题。如果你的 Win10 机器没有 Z 盘的写权限，这个错误是正常的，不是操作系统的问题，而是你的配置文件/组策略/驱动器权限/等等的问题。

标签： windows vba excel csv

【解决方案1】：

这有点棘手。

MkDir 函数不能一次创建一个Drive:\Directory\Subdirectory——它试图在一个不存在的目录中创建子目录，所以你首先必须创建目录，然后然后 em> 你可以用它来创建子目录：

MkDir "Drive:\Directory"
MkDir "Drive:\Directory\Subdirectory"

所以这很可能解释了为什么即使在 Win10 机器的 C 盘上也会出现故障。

关于 Z & E 驱动器（假设它们是共享），如果您无权从 Win10 机器访问或写入这些驱动器，则会发生类似的错误；这不是 VBA 可以解决的问题，除非它是一个简单的驱动器号映射问题，在这种情况下，您可以通过提供完整的规范路径来解决它，例如：

MkDir "\\servername\Directory"

由于您在 SaveAs 上仍然遇到错误，请检查 Fname 的值。

您正在从以下位置提取日期值：

DataSheet.Range("B1").Value

这包括不能在文件名中使用的正斜杠字符。

试试吧：

Format(DataSheet.Range("B1").Value, "yyyymmdd")

【讨论】：

我有 2 台电脑并在两台电脑上本地运行宏。 pc1有win8.1，pc2有win10。我已确保所有目录都已就位。执行宏时仅创建最终目录。该最终目录被命名为当前日期。此外，宏正在创建名为 {current date} 的最终文件夹。只有文件没有保存
所以它现在只在ActiveSheet.SaveAs... 失败？ FName 的值是多少？
strDirname = Format(CStr(Now), "DDMMMYY") ' New directory namestrDefpath = "C:\MyBackfill\Extracts\"MkDir strDefpath & strDirnamePath = strDefpath & strDirname & "\" 'create total stringFilename = "GFill" & " " & "NIFTY" & " " & dt & " " & "FROM" & "_" & DataSheet.Range("B1").Value & ".csv"FName = Path & Filename
没有。请显示变量FName 的实际值。我可以清楚地看到它是如何构造的，但是我想看看它发生错误时的是什么。
您在目标文件名中有正斜杠，这些是不允许的（以及一些其他特殊字符/标点符号）。这总是会引发错误

【解决方案2】：

感谢大卫·泽门斯。

他指点我使用即时窗口。

问题出现了，因为由于某种原因“/”出现在文件名中，而这不应该。

适当地编辑 FileName 变量以删除“/”并且文件正在正确生成。

请注意，win8.1 中不会出现同样的问题

【讨论】：