Excel Erro em tempo de execução '13'

[RudolfS]

Ao clicar num macro que gera PDF a partir de dados da planilha, aparece Erro em tempo de execução '13', ao depurar aparece que o erro é: Nome = Sheets("FM").Range("C2").Value & ".pdf"

[AfonsoMira]

Boas, por favor disponibilize o código completo para poder ajudar melhor.

Obrigado.

[RudolfS]

Sub eCOMMERCE()
'
' eCOMMERCE Macro
'
' Atalho do teclado: Ctrl+Shift+E
'
    Sheets("E-COMMERCE").Select
End Sub
Sub RASTREIO()
'
' RASTREIO Macro
'
' Atalho do teclado: Ctrl+Shift+R
'
    Sheets("Rastreamento").Select
End Sub
Sub CONTRATOS()
'
' CONTRATOS Macro
'
' Atalho do teclado: Ctrl+Shift+C
'
    Sheets("Contratos").Select
End Sub
Sub MULTIPRE()
'
' MULTIPRE Macro
'
' Atalho do teclado: Ctrl+Shift+M
'
    Sheets("MULTI PRÉ").Select
End Sub
Sub NOVOS()
'
' NOVOS Macro
'
' Atalho do teclado: Ctrl+Shift+N
'
    Sheets("BaseC").Select
End Sub
Sub SALVAR()
'
' SALVAR Macro
'
' Atalho do teclado: Ctrl+Shift+S
'
    ActiveWorkbook.Save
End Sub

Sub Fechamento(ByVal destinatario As String, body As String)

    Dim Nome As String
    Dim SDate As String
    Dim MyLocal As String
    Dim nomeArquivo As String
    
    MyLocal = "D:\Gestão\"
    'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs\"
    Nome = Sheets("FM").Range("C2").Value & ".pdf"
    nomeArquivo = MyLocal & Nome
    SDate = Now
    
    If Nome <> vbNullString Then
        Sheets("FM").ExportAsFixedFormat Type:=xlTypePDF, Filename:=MyLocal & Nome, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        'If InStr(1, destinatario, "@", 1) <> 0 Then
        '    Call Envio(nomeArquivo, destinatario, body)
        'End If
    Else
        MsgBox "Nome do arquivo inválido", vbOKOnly, "Salvo"
    End If

End Sub

Sub FCP(ByVal destinatario As String, body As String)

    Dim Nome As String
    Dim SDate As String
    Dim MyLocal As String
    Dim nomeArquivo As String
    
    MyLocal = "D:\Gestão\"
    'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs_fcp\"
    Nome = Sheets("FCP").Range("j4").Text & ".pdf"
    nomeArquivo = MyLocal & Nome
    SDate = Now
    
    If Nome <> vbNullString Then
        Sheets("FCP").ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomeArquivo, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        'If InStr(1, destinatario, "@", 1) <> 0 Then
         '   Call Envio(nomeArquivo, destinatario, body)
        'End If
    Else
        MsgBox "Nome do arquivo inválido", vbOKOnly, "Salvo"
    End If

End Sub

Sub remover_duplicadas(ByVal j As Integer)
    
    Application.ScreenUpdating = False
    
    Dim i As Integer
    i = 2
    
    Sheets("BaseAuxiliar").Activate
    
    If j = 1 Then
        Sheets("BaseAuxiliar").Range("B2:B3428").Select
        Selection.ClearContents
        
        Sheets("BaseAuxiliar").Range("A1:A3428").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
            "B1"), Unique:=True
            
        Sheets("BaseAuxiliar").Range("d2").Select
        
        Do While i <= 642
            If Sheets("BaseAuxiliar").Range("B" & i).Text <> "" And Len(Sheets("BaseAuxiliar").Range("B" & i).Text) > 0 Then
                Sheets("FM").Range("$A$12:$P$435").AutoFilter Field:=8, Criteria1:=Sheets("BaseAuxiliar").Range("B" & i).Text
                Sheets("FM").ListObjects("Tabela1").Range.AutoFilter Field:=8, Criteria1:=Sheets("BaseAuxiliar").Range("B" & i).Text
                Call Fechamento(Sheets("BaseAuxiliar").Range("c" & i).Text, Sheets("BaseAuxiliar").Range("d" & i).Text)
               'Call Fechamento("[email protected]", Sheets("BaseAuxiliar").Range("d" & i).Text)
            End If
            i = i + 1
        Loop
        Sheets("FM").Range("$A$12:$P$435").AutoFilter Field:=8
        Sheets("FM").ListObjects("Tabela1").Range.AutoFilter Field:=8
        
        'MsgBox "Deixa sem mensagem"
        
    ElseIf j = 2 Then
        Sheets("BaseAuxiliar").Range("g2:g435").Select
        Selection.ClearContents
        
        Sheets("BaseAuxiliar").Range("f1:f435").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
            "g1"), Unique:=True
        
        
        
        Do While i <= 424
            If Sheets("BaseAuxiliar").Range("G" & i).Text <> "" Then
                Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=7, Criteria1:="MULTI PRÉ"
                Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=15, Criteria1:="NÃO"
                Sheets("FCP").Range("$A$19:$O$441").AutoFilter Field:=5, Criteria1:=Sheets("BaseAuxiliar").Range("G" & i).Text
                Call FCP(Sheets("BaseAuxiliar").Range("h" & i).Text, Sheets("BaseAuxiliar").Range("i" & i).Text)
            End If
            '
            'ActiveSheet.Range("$A$19:$O$442").AutoFilter Field:=7
            'ActiveSheet.Range("$A$19:$O$442").AutoFilter Field:=15
            i = i + 1
        Loop
        
        Sheets("FCP").Range("$A$19:$O$442").AutoFilter Field:=5
    End If
    
    
End Sub

Sub gerar_fcp()
    Call remover_duplicadas(2)
    'MsgBox "Concluído"
End Sub

Sub gerar_um_fcp()
    Call FCP("teste", "teste")
    'MsgBox "Concluído"
End Sub

Sub gerar_um_fm()
    Call Fechamento("teste", "teste")
    'MsgBox "Concluído"
End Sub

Sub gerar_fm()
    Call remover_duplicadas(1)
    'MsgBox "Concluído"
End Sub
Sub Envio(ByVal path1 As String, destinatario As String, body As String)
    
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    
    'Criação e chamada do Objeto Outlook
    'verifica se o Outlook está aberto, caso não esteja, cria nova instância
    
    Set OutApp = CreateObject("Outlook.Application")
    
    Set OutMail = OutApp.CreateItem(olMailItem)
    Application.DisplayAlerts = False
    
    With OutMail
        .To = destinatario
        .CC = ""
        .BCC = "[email protected]"
        .Subject = "Fechamento " & Sheets("FM").Range("C1").Text
        .HTMLBody = "Olá " & body & ". <br><br>Segue anexo seu fechamento semanal referente ao Período de " & Sheets("BaseAuxiliar").Range("K2")
        'O trecho abaixo anexa a planilha ao e-mail
        .Attachments.Add path1
        .send 'Ou .Display para mostrar o email
    End With
    
    Application.DisplayAlerts = True
    
    'Resetando a sessão
        Set OutMail = Nothing
        Set OutApp = Nothing
End Sub

8 minutos atrás, InforMira disse:

Boas, por favor disponibilize o código completo para poder ajudar melhor.

Obrigado.

Boas amigo, salvei acima.

Não sei se por estar usando o arquivo em um notebook diferente está impedindo de gerar o PDF, visto que tem um endereço de e-mail diferente no código acima.

[AfonsoMira]

Verifique se este caminho está correto?

Pode ser esse o problema. Ele pode não estar a reconhecer o caminho.
 

 'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs\"

 

[RudolfS]

8 minutos atrás, InforMira disse:

Verifique se este caminho está correto?

Pode ser esse o problema. Ele pode não estar a reconhecer o caminho.
 

 'MyLocal = "C:\Users\Jeferson\Desktop\Proj mototurbo\pdfs\"

 

Não, como faço para colocar o local correto?

[AfonsoMira]

@RudolfS 

1. Vai na pasta que deseja colocar o PDF.
2. Clique com o botão direito do mouse.
3. Propriedades.
4. Aba segurança.
5. Onde diz "Nome do objeto:" O caminho correto é esse que está na frente.

 

[RudolfS]

7 minutos atrás, InforMira disse:

@RudolfS 

1. Vai na pasta que deseja colocar o PDF.
2. Clique com o botão direito do mouse.
3. Propriedades.
4. Aba segurança.
5. Onde diz "Nome do objeto:" O caminho correto é esse que está na frente.

 

Mudei e ainda não resolveu

[AfonsoMira]

@RudolfS Sendo assim consegue disponibilizar o arquivo?
Tem que zippar pode ser .rar ou .zip
Depois anexe aqui.