Snasui Excel Forum

Code: Select all

 Sub SlipCreate()
Worksheets("data").Range("A:A").Clear
Worksheets("data").Range("A2").Value = "O"
Sheets("data").Select

Dim i As Integer
Dim fName As String
Dim folderName As String
Dim path As String
path = ThisWorkbook.path & "/Slip/"
i = 2
Do
    If Not IsEmpty(Sheets("data").Range("B" & i).Value) Then
        fName = "J" & Format(Sheets("data").Range("B" & i).Value, "000000") & "_" & Format(Date, "yyyy") & Format(Date, "mm")
        folderName = "J" & Format(Sheets("data").Range("B" & i).Value, "000000")
        Sheets("slip").Range("A1").Value = Format(Sheets("data").Range("B" & i).Value, "000000")
        Sheets("data").Range("A" & i - 1).ClearContents
        Sheets("data").Range("A" & i).Value = "O"
        chkFolder path & folderName
        ExportPDF path & folderName, fName
    Else
        Exit Do
    End If
    i = i + 1
Loop


End Sub

Sub ExportPDF(path As String, fName As String)
    Worksheets("slip").ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=path & "/" & fName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

Sub chkFolder(path As String)
    If Len(Dir(path, vbDirectory)) = 0 Then
        MkDir path
    End If
End Sub