Save copy of an open Workbook and make pdf for archive

[vvujke]

Hi,

sorry for the code, couldn't make it work with VB HTML Maker. I'm new with VBA Basically my idea is when someone open default file, insert data, try to save file, macros save workbook with inserted data as another file (*.xlsx) and make pdf in another folder. Pdf part is working fine and i'll leave it here if someone can use it (i've saw couple of threads with this enquiries), but with second part just can't find right option

Pdf part

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim Name As String
Dim i As Integer, j As Integer

Name = ThisWorkbook.Path & "\PDF Archive\" & ActiveSheet.Range("F6") & " Invoice " & ActiveSheet.Range("B11")
If Dir(Name & ".pdf") <> "" Then
If Dir(Name & " copy.pdf") <> "" Then
i = 1
j = 1
Do While i = 1
If Dir(Name & " copy (" & CStr(j) & ").pdf") <> "" Then
j = j + 1
i = 1
Else
i = 2
End If
Loop
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Name & " copy (" & CStr(j) & ").pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Name & " copy" & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Name & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub

Excel part

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String

Application.ScreenUpdating = False ' Prevents screen refreshing.

CurrentFile = ThisWorkbook.FullName

NewFileType = "Excel Files 2007 (*.xlsx), *.xlsx," & _
"Excel Files 1997-2003 (*.xls), *.xls," & _
"All files (*.*), *.*"


NewFile = Application.GetSaveAsFilename( _
InitialFileName:=ThisWorkbook.Path & "\" & ActiveSheet.Range("F6") & " Invoice " & ActiveSheet.Range("B11") & ".xlsx", _
fileFilter:=NewFileType)


If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=51, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Application.DisplayAlerts = False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If

Application.ScreenUpdating = True
End Sub


Thanks guys for your time
P.S Sorry if i've made any language mistake

 

[vvujke]

anyone? really need help