Bom dia,

Pessoal, preciso da ajuda de vocês, tenho a macro abaixo para criar pastas e sub-pastas com a data e salvar o arquivo, quando executo a mesma dentro do próprio arquivo, sem problema, mas o que eu preciso é executá-la em um arquivo do excel compartilhado, então fiz o seguinte gravei a macro no arquivo Personal e abro a mesma só que quando executo dá o seguinte erro de tempo de execução: erro na seguinte linha de comando:
ThisWorkbook.SaveAs "W:Mario" & PastaMes & "" & PastaData & "" & NameFile
Se puderem me dar uma dica, acho que deve haver uma forma de ele se referir ao arquivo aberto no momento.

Sub Salva()
Application.ScreenUpdating = False
Dim PastaMes As String
Dim PastaData As String
Dim NameFile As String
Dim OK As Boolean

PastaMes = Format(Now, "mm") & "-" & Format(Now, "mmmm") & "-" & Format(Now, "yyyy")
PastaData = Format(Now, "dd-mm-yyyy")
NameFile = Format(Now, "dd-mm-yyyy-hhmm - ") & "Fluxo de Pedidos" & ".xlsm"
OK = CreateFolders(PastaMes, "W:Mario")

If Not OK Then Exit Sub

CreateFolders PastaData, "W:Mario" & PastaMes
ThisWorkbook.SaveAs "W:Mario" & PastaMes & "" & PastaData & "" & NameFile

MsgBox "! Arquivo Salvo com Sucesso."
Application.ScreenUpdating = False
End Sub

Function CreateFolders(sSubFolder As String, ByVal sBaseFolder As String) As Boolean
CreateFolders = True
'Acrescenta a barra ao final do endereço da pasta
If Right(sBaseFolder, 1) <> "" Then
sBaseFolder = sBaseFolder & ""
End If

'Verifica se a pasta base existe
If Len(Dir(sBaseFolder, vbDirectory)) > 0 Then
'Verifica se a subpasta existe
If Len(Dir(sBaseFolder & sSubFolder, vbDirectory)) = 0 Then
'Se a subpasta não existir, ela é criada
MkDir sBaseFolder & sSubFolder
End If
Else 'A pasta base não existe...
MsgBox "A pasta base não existe!" & vbCrLf & sBaseFolder, vbExclamation
CreateFolders = False
End If
End Function