Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Criar pasta e gerar...
 
Notifications
Clear all

Criar pasta e gerar pdf

 
2024 - VBA & Macros
2 Posts
2 Usuários
0 Reactions
1,071 Visualizações
RSS
 BetoRubini
(@betorubini)
Posts: 57
Trusted Member
Topic starter
 

olá estou com uma rotina que gera um arquivo em PDF da mesma pasta m que está o documento do excel

gostaria de adapta-la para que criasse uma pasta ex: "C:pastaPDF" e salvasse o pdf na mesma,
se a pasta já existir salvar dentro da mesma.

rotina que estou usando

im SvInput As String
Dim Data As String
Dim var_MENSAGEM
Dim Nome As String
Dim UltimaLinha As Long
    Sheets("Ficha Cliente").Select
UltimaLinha = Cells(Rows.Count, "A").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = Range("$A$1:$h$" & UltimaLinha).Address

Data = VBA.Format(VBA.Date, "dd-mm-yyyy")
SvInput = ThisWorkbook.Path & Application.PathSeparator & nomecliente & " - FICHA.CLIENTE - " & Data & ".pdf"
mensagem = MsgBox("PDF salvo com os dados do cliente:  " & nomecliente)
        With ActiveSheet
            .ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=SvInput, _
                OpenAfterPublish:=True
        End With

Obrigado

 
Postado : 22/06/2013 10:30 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite!!

Já usou a pesquisa do fórum???

Tente algo........

Option Explicit

Private Const theDrive As String = "C"
Private Const theDriveFormat As String = ":"
Private Const theDir As String = "pastaPDF"
Private Const theDirFormat As String = ""
 
Public targetpath As String
Sub Part_I_8634()

    If testDir = True Then
         'Sua Rotina
        Exit Sub
    Else
        MkDir targetpath
    End If
theEnd:
     '    Sua Rotina
    Exit Sub
End Sub
Function testDir() As Boolean
  
    testDir = False
    targetpath = theDrive
    targetpath = targetpath & theDriveFormat
    targetpath = targetpath & theDir
    targetpath = targetpath & theDirFormat
    If Dir(targetpath, vbDirectory) = "" Then testDir = False _
Else
    testDir = True
theEnd:
     'Sua Rotina
    Exit Function
End Function

Ou....

Sub AleVBA()
Dim rspCreate
If Dir("C:pastaPDF", vbDirectory) = "" Then
    rspCreate = MsgBox("Diretorio não existe, Você deseja Criar?", vbYesNo)
     
    If rspCreate = vbYes Then
        MkDir "C:pastaPDF"
    End If
End If
End Sub
 
Postado : 22/06/2013 3:50 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico