Мой код продолжает глючить на
.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