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
1 Respuesta
Respuesta de Dante Amor
1