CSV saves on wrong location - vba

Question

My code is saving in Local/temporary somewhere - It's supposed to save on Desktop, AND if it already exists, ask before overwriting. Can you help me?
Sub Opgave8()
Dim sh As Worksheet
Dim Pth As String
Application.ScreenUpdating = False
Pth = ActiveWorkbook.Path
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
With ActiveWorkbook
.SaveAs Filename:=Pth & "\AdminExport.csv", FileFormat:=xlCSV
.Close False
End With
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

Answer 1

Try using Environ$("USERPROFILE") to create a default desktop save path, then create a simple message box with YesNo option as the code shows:
Sub Opgave8()
Dim sh As Worksheet
Dim Pth As String
Application.ScreenUpdating = False
' Create default desktop path using windows user id
user_id = Environ$("USERPROFILE")
' Create full path
file_name$ = "\AdminExport.csv"
Pth = user_id & "\Desktop" & 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
If Dir(Pth, vbArchive) <> vbNullString Then
overwrite_question = MsgBox("File already exist, do you want to overwrite it?", vbYesNo)
End If
If overwrite_question = vbYes Then
With ActiveWorkbook
.SaveAs Filename:=Pth, FileFormat:=xlCSV
.Close False
End With
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