Excel 매크로가 Win8.1에서 csv를 저장할 수 있지만 Win10에서 저장/작업을 중단 함

Question

Win10에서 작동하도록하기 위해 아래의 VBA 코드를 어떻게 수정할 수 있습니까? 그것은 Win8.1에서 잘 작동합니다. 내 Win10 컴퓨터에서 디렉토리를 생성하지만 CSV를 저장할 수 없습니다.

이 코드는 나 자신이 데이터 가져 오기 코드 (소스 : http://investexcel.net)에 CSV 저장 기능을 추가하여 작성한 추가 부분입니다.

Run-time error 1004: Application defined or object defined error

누르면 디버그가 나를 취 아래

이 오류가있어 취소 누르면 전체 매크로를 실행하는 동안 내가받은 오류 메시지 (Application.DisplayAlerts를 한 후 = 참)

'16.csdv' cannot be accessed. The file may be corrupted, located on a server that is not responding, or read-only. (Options - Retry/Cancel)

입니다 이 부분의 코드 (노란색으로 강조 표시)

전체 코드 본문은 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 

Answer 1

이것은 다소 까다 롭습니다. 존재하지 않는 디렉토리에서 하위 디렉토리를 만들려고, 그래서 먼저 디렉토리를 생성해야하고, 그런 다음 생성하는 데 사용할 수 있습니다 -

MkDir 기능은 모두 한 번에 Drive:\Directory\Subdirectory를 만들 수 없습니다 하위 디렉토리 :

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

이렇게하면 Win10 컴퓨터의 C 드라이브에서도 오류가 발생하는 이유가 가장 잘 설명됩니다.

Z & E 드라이브 (해당 드라이브가 공유라고 가정)에 대해 Win10 컴퓨터에서 해당 드라이브에 액세스하거나 쓰기 권한이 없으면 유사한 오류가 발생합니다. 이 간단한 드라이브 문자 매핑 문제가되는 경우에 당신은 아마 전체 정식 경로를 제공하여 해결할 수 있습니다하지 않는 즉, VBA로 해결 될 수있는 문제가 아니다, 예를 들면 : 당신으로

MkDir "\\servername\Directory" 

' SaveAs에서 여전히 오류가 발생하는 경우 Fname 값을 확인하십시오.

당신은에서 날짜 값 당기는하고

:

DataSheet.Range("B1").Value

그리고이 앞으로 포함 파일 이름에 사용할 수없는 문자를 슬래시.

대신보십시오 : 데이비드 Zemens에

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

Answer 2

감사합니다.

그는 즉각적인 창을 사용하도록 나를 지적했습니다.

어떤 이유로 "/"이 파일 이름에 올라 왔기 때문에 문제가 발생했습니다.

FileName 변수를 적절히 편집하여 "/"을 제거하면 파일이 제대로 생성됩니다.

이 문제는 win8.1에서 발생하지 않습니다.