Создать CSV файл MAC - PullRequest
       10

Создать CSV файл MAC

0 голосов
/ 17 мая 2018

Мой код продолжает глючить на

        .SaveAs FileName:=Pth, FileFormat:=xlCSV

Я работаю над MAC, но он должен работать как на Mac, так и на Windows. Кто-нибудь знает, как это исправить? :)

    Sub Opgave8()
    Dim sh As Worksheet
    Dim user_id As String
    Dim file_name As String
    Dim Pth As String
    Dim overwrite_question As Integer
    Dim i As Integer

    Application.ScreenUpdating = False


    user_id = Environ$("USERPROFILE")
    file_name = "AdminExport.csv"
   ' Pth = user_id & "\Desktop\" & file_name
   Pth = user_id & Application.PathSeparator & "Desktop" & Application.PathSeparator & file_name

    Set sh = Sheets.Add

    For i = 2 To 18288
        If Left(Worksheets("Base").Cells(i, 12), 6) = "262015" Then
            sh.Cells(i, 2) = Worksheets("Base").Cells(i, 4)
        End If
    Next i

    sh.Move

    overwrite_question = vbNo
    If Dir(Pth) <> "" Then
        overwrite_question = MsgBox("File already exist, do you want to overwrite it?", vbYesNo)
    Else
        With ActiveWorkbook
            .SaveAs FileName:=Pth, FileFormat:=xlCSV
            .Close
        End With
    End If

    If overwrite_question = vbYes Then
        Application.DisplayAlerts = False
        With ActiveWorkbook
            .SaveAs FileName:=Pth, FileFormat:=xlCSV
            .Close False
        End With
        Application.DisplayAlerts = True
    End If

    Application.ScreenUpdating = True

End Sub




Function UniqueRandDigits(x As Long) As String
    Dim i As Long
    Dim n As Integer
    Dim s As String
    Do
        n = Int(Rnd() * 10)
        If InStr(s, n) = 0 Then
            s = s & n
            i = i + 1
        End If
    Loop Until i = x + 1

    UniqueRandDigits = s
End Function

1 Ответ

0 голосов
/ 17 мая 2018

Этот путь не будет работать на Mac. Вы должны использовать что-то вроде этого:

Pth = user_id & Application.Pathseparator & "Desktop" & Application.Pathseparator & file_name
...