Snasui Excel Forum

Code: Select all

Sub ExportPdf()
'    Range("L5").Select
'    ActiveCell.FormulaR1C1 = "=CELL(""filename"")"
'    Range("L6").Select
'    ActiveCell.FormulaR1C1 = "=MID(CELL(""filename""),FIND(""["",CELL(""filename""))+1,FIND(""]"",CELL(""filename""))-FIND(""["",CELL(""filename""))-1)"
'    Range("L7").Select
'    ActiveCell.FormulaR1C1 = "=MID(CELL(""filename"",R[-1]C),FIND(""]"",CELL(""filename"",R[-1]C))+1,256)"
'    Range("L9").Select
'    ActiveCell.FormulaR1C1 = "=LEFT(R[-4]C,LEN(R[-4]C)-R[-1]C[1])"
'    Range("L10").Select
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & Range("E2").Value & ".pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Sheets("sheet1").Select
    Range("A1").Select
    ActiveWorkbook.Save
    MsgBox "Finish"
  End Sub

Code: Select all

MkDir "C:\Users\"
            MkDir "C:\Users\THOMAS-611\"
            MkDir "C:\Users\THOMAS-611\OneDrive\"
            MkDir "C:\Users\THOMAS-611\OneDrive\สูตรExcel\"
            MkDir "C:\Users\THOMAS-611\OneDrive\สูตรExcel\address\" & s
            

Code: Select all

 tPath = "C:\Users\THOMAS-611\OneDrive\สูตรExcel\address\" '<== Target path
    For Each s In Sheets("Sheet1").Range("E1")
        If Dir(tPath & s, vbDirectory) = vbNullString Then
            MkDir "C:\Users\"
            MkDir "C:\Users\THOMAS-611\"
            MkDir "C:\Users\THOMAS-611\OneDrive\"
            MkDir "C:\Users\THOMAS-611\OneDrive\สูตรExcel\"
            MkDir "C:\Users\THOMAS-611\OneDrive\สูตรExcel\address\" & s
        End If
        

Code: Select all

Sub Create()
    Dim tPath As String
    Dim s As Range
    Dim sPath As String
    Dim a As Variant
    Dim b() As Variant
    Dim i As Integer
    Dim p As String
    
    On Error Resume Next
    'sPath = "D:\New Folder\" '<== Source path
    tPath = "C:\Users\THOMAS-611\OneDrive\ÊÙµÃExcel\address\" '<== Target path
    a = VBA.Split(tPath, "\")
    For i = 0 To UBound(a)
        ReDim Preserve b(i)
        b(i) = a(i)
        With Application
            p = VBA.Join(.Transpose(.Transpose(.WorksheetFunction.Index(b, 0))), "\")
        End With
        If Dir(p, vbDirectory) = vbNullString Then
            MkDir p
        End If
    Next i
    
    For Each s In Sheets("Sheet1").Range("E1")
'        If Dir(tPath & s, vbDirectory) = vbNullString Then
'            MkDir "C:\Users\"
'            MkDir "C:\Users\THOMAS-611\"
'            MkDir "C:\Users\THOMAS-611\OneDrive\"
'            MkDir "C:\Users\THOMAS-611\OneDrive\ÊÙµÃExcel\"
'            MkDir "C:\Users\THOMAS-611\OneDrive\ÊÙµÃExcel\address\" & s
'        End If
        FileCopy sPath & s.Offset(0, -3), tPath & s & "\" & s.Offset(0, -3)
    Next s
End Sub

Code: Select all

Sub Create()
    Dim tPath As String
    Dim s As Range
    Dim sPath As String
    Dim a As Variant
    Dim b() As Variant
    Dim i As Integer
    Dim p As String
    
    On Error Resume Next
    'sPath = "D:\New Folder\" '<== Source path
    tPath = ThisWorkbook.Path & "\" & Sheets("Sheet1").Range("e1").Value '<== Target path
    'Other code