Exportar en la carpeta creada, no funciona
Tengo esto y funciona perfecto. Lo único es que cuando crea la carpeta no exporta en ella sino afuera en la otra que la contiene..
Sub GUARDAR()
'On Error Resume Next
'Abre word
Dim num As Variant
Dim base2 As String
Dim Namek As String
Dim Carpeta As Object
Dim ruta As String
Dim ruta3 As String
Dim ruta4 As Variant
Dim carpetafinal As String
'Ambiente
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
num = Sheets("Ficha").Range("F2").Value
ruta = Environ("USERPROFILE") & "\Dropbox\TODAS\"
'datos para la carpeta
base2 = Cells(4, "F") & " " & Cells(4, "G") & " " & Cells(4, "C") & " " & Cells(4, "D") & "-" & num
'ruta completa
ruta3 = ruta & base2
ruta4 = Dir(ruta & "*" & num, vbDirectory)
carpetafinal = ruta & ruta4
'Folder crear o encontrar
Application.ScreenUpdating = False
Set Carpeta = CreateObject("Scripting.FileSystemObject")
'
'nombre del archivo
Namek = num & ("-") & Format(Now, "ddmmyyyy")
If ruta4 <> "" Then
MsgBox "ENCONTRADO.", vbInformation, "Kutools for Excel"
'Exportar archivo
Sheets("PDF").ExportAsFixedFormat xlTypePDF, carpetafinal & "\" & Namek & ".pdf", xlQualityStandard, True, False, , , False
Else
Carpeta.CreateFolder (ruta3)
MsgBox "CREADA.", vbInformation, "Kutools for Excel"
Sheets("PDF").ExportAsFixedFormat xlTypePDF, carpetafinal & "\" & Namek & ".pdf", xlQualityStandard, True, False, , , False
End If
Sheets("Ficha").Select
End Sub
Respuesta de Dante Amor
1
Está creando la carpeta ruta3
Carpeta. CreateFolder (ruta3)
Pero quieres exportar en la capeta ruta4
Sheets("PDF"). ExportAsFixedFormat xlTypePDF, ruta4En mi código utilizo la función dir( ) para revisar si existe la carpeta.
arch = Dir(carpetaInicial & "*" & num, vbDirectory)
En tu código, la variable ruta4 no es necesaria, porque estás utilizando esto para revisar si existe la carpeta:
Set Carpeta = CreateObject("Scripting.FileSystemObject")
If Carpeta.FolderExists(ruta3) ThenLo siguiente debería funcionar para lo que necesitas:
Sub GUARDAR()
Dim num As Variant
Dim Carpeta As Object
Dim base2 As String, Namek As String
Dim ruta As String, ruta3 As String
'Ambiente
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
ruta = Environ("USERPROFILE") & "\Dropbox\TODAS\"
num = Sheets("Ficha").Range("F2").Value
'datos para la carpeta
base2 = Cells(4, "F") & " " & Cells(4, "G") & " " & Cells(4, "C") & " " & Cells(4, "D") & "-" & num
ruta3 = ruta & base2
'Folder crear o encontrar
Set Carpeta = CreateObject("Scripting.FileSystemObject")
If Carpeta.FolderExists(ruta3) Then
MsgBox "ENCONTRADO.", vbInformation, "Kutools for Excel"
Else
Carpeta.CreateFolder (ruta3)
MsgBox "CREADA.", vbInformation, "Kutools for Excel"
End If
'nombre del archivo
Namek = num & ("-") & Format(Now, "ddmmyyyy")
'Exportar archivo
Sheets("PDF").ExportAsFixedFormat xlTypePDF, ruta3 & "\" & Namek & ".pdf", xlQualityStandard, True, False, , , False
Sheets("Ficha").Select
End Sub[Prueba y comentas.
