Access to convert Excel to PDF - Issue

[MikeyMike]

Hi All,

Wondering if anyone has any experience of this, fault finding I proving to be difficult.

I have a database in Access, which then output to an excel sheet and them save as PDF.

Access writes a line in one tab of Excel, which then auto populates a template (like a certificate). Access then Exports the excel as a PDF using "ActiveWorkbook.ExportAsFixedFormat" function and then loops to the next line.

This is then on a loop which continues to write each line to the excel document.

When I have the Excel sheet open, I can see the data being written and then over written by the next line. The program publishes the PDF's, but when I open the PDFs, they are all blank.

The fact that the files are being published, means that the function is correct, so I suspect a timing issue???

Here is my code:

DoCmd.RunSQL ("SELECT Data.* INTO tbl_Temp FROM tbl_Data WHERE [tbl_Data.Value]= " & "'" & strValue & "'")
DoCmd.TransferSpreadsheet acExport, 10, "tbl_Temp", "Location of template", False, "Data_Temp!" 'Temp REF!" 'EXPORT TO EXCEL FILE
Me.Refresh

With XL

.Workbooks.Open "Excel Location here"
'.Workbooks("Template.xlsx").Model.Refresh
'Me.Refresh
'Me.Repaint

.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Location" & strValue & ".pdf"
.ActiveWorkbook.Close (False)
.Quit
End With

Thanks in advance & Best Regards
Mike

 

[arnelgp]

maybe on the timing, i agree if
the pdfs are created.

maybe you can delete first the öld pdf so
we can test if it is created or not:

...
...

With XL
'
.Workbooks.Open "Excel location here"
'Me.repaint

if dir("Location" & strValue & ".pdf")<> "" Then Kill ("Location" & strValue & ".pdf")
.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Location"& strValue & ".pdf"

'here we check
dim intLoop As Byte
Do While True
	if dir("Location" & strValue & ".pdf")<>""
		if filelen("Location" & strValue & ".pdf")<> 0 then
			exit do
		end if
	end if
	intloop = intloop + 1
	'this prevents endless loop if the file is not found or has 0 length
	if intloop > 20 then
		exit do
	end if
Loop
.ActiveWorkbook.Close (False)
End With
XL.Quit
Set XL=Nothing

 

[MikeyMike]

Hi Arnel,

Thank you for the fast response, greatly appreciated

When I input your code over, I get a number of compile errors unfortunately.

As an FYI, the documents are published, and it contains the template, but all of the fields are just blank.

Yet when I run the programme with the excel template open on screen, I can see that it is writing the text correctly, and despite it publishing at seemingly the right time I still get nothing...

I.E. the correct data gets pulled from the access database, excel gets populated, access publishes document, then the excel gets over written with the next line.

Would it help If I publishes my entire code?

Its actually not that much considering the actions involved.

Best Regards
Mike

 

[arnelgp]

Yes ut would helo

 

[MikeyMike]

Hi Arnel,

Please see bellow the full script.

In Access I you will see I have two tables, the data table which holds the imported data set, and Temp table which holds the line which is being exported to excel.

Best Regards
Mike

Option Compare Database

Private Sub Command0_Click()

Dim DBS As DAO.Database
Dim rstVin As DAO.Recordset, rstRecord As DAO.Database
Dim strVin As String, XL As Object, intCounter As Integer, intRecCount As Integer, dblStart As Double, dblEnd As Double, dblElapsed As Double

DoCmd.SetWarnings False

dblStart = Time()

Set DBS = CurrentDb
Set rstVin = DBS.OpenRecordset("SELECT [Value] FROM tbl_Data")

rstVin.MoveFirst

intCounter = 0
intRecCount = 0

intRecCount = DCount("Value", "tbl_Data")

txtRunSum.Value = intCounter
txtTotal.Value = intRecCount


Me.Refresh

Do Until rstVin.EOF

Set XL = CreateObject("Excel.Application")

strVin = rstVin!VIN

DoCmd.RunSQL ("SELECT tbl_Data.* INTO tbl_Temp FROM tbl_Data WHERE [tbl_Data.Value]= " & "'" & strVin & "'")
DoCmd.TransferSpreadsheet acExport, 10, "tbl_Temp", "Template location", False, "Data_Temp!" 'EXPORT TO EXCEL FILE


With XL

.Workbooks.Open "Template Location"
'Me.Refresh
'Me.Repaint

.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Export Location" & strValue & ".pdf"
.ActiveWorkbook.Close (False)
.Quit
End With

Set XL = Nothing

rstVin.MoveNext
Me.Repaint

intCounter = intCounter + 1

txtRunSum.Value = intCounter
txtComplete.Value = Format(intCounter / intRecCount, "Percent")
Me.Recalc

Loop


Set XL = Nothing
Set rstVin = Nothing
Set DBS = Nothing

dblEnd = Time()
dblElapsed = dblEnd - dblStart

MsgBox "Elapsed: " & Format(dblElapsed, "Long Time"), vbExclamation, "Time Elapsed"


End Sub

Private Sub Form_Timer()

Me.TimerInterval = 1000

txtElapsed.Value = Time()

End Sub

 

[CJ_London]

@Mikey, I wont be contributing to this thread at this time, but to encourage others to do so, please enclose your code in the code tags (highlight the pasted code and click on the # button). This will preserve indentation and makes it easier for others to read and interpret the program flow.

 

[MikeyMike]

@Mikey, I wont be contributing to this thread at this time, but to encourage others to do so, please enclose your code in the code tags (highlight the pasted code and click on the # button). This will preserve indentation and makes it easier for others to read and interpret the program flow.

Hi CJ,

Apologies, will do this in future.

Mike

 

[arnelgp]

just make one instance of XL through the rest of the
code. add a "pause" for each pdf creation, just to give
time for the creation to proceed:

Set XL = CreateObject("Excel.Application")

Do Until rstVin.EOF


    strVin = rstVin!VIN

    DoCmd.RunSQL ("SELECT tbl_Data.* INTO tbl_Temp FROM tbl_Data WHERE [tbl_Data.Value]= " & "'" & strVin & "'")
    DoCmd.TransferSpreadsheet acExport, 10, "tbl_Temp", "Template location", False, "Data_Temp!" 'EXPORT TO EXCEL FILE


    With XL

        .Workbooks.Open "Template Location"
        'Me.Refresh
        'Me.Repaint

	.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Export Location" & strValue & ".pdf"
	Sleep 2000 'pause for 2 secs

	.ActiveWorkbook.Close (False)
    End With


    rstVin.MoveNext
    Me.Repaint

    intCounter = intCounter + 1

    txtRunSum.Value = intCounter
    txtComplete.Value = Format(intCounter / intRecCount, "Percent")
    Me.Recalc

Loop

XL.Quit
Set XL=Nothing

put this in Standard Module:

Option Compare Database
Option Explicit

#If VBA7 Then
        Private Declare PtrSafe Sub Sleep Lib "Kernel32" _
            (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "Kernel32" _
        (ByVal dwMilliseconds As Long)

#End If

 

[arnelgp]

Hello again just run your code. You have warnings off there so you cant see the error.
The error is that you cant create tbl_temp if it already exists.

here is the fix:

Set XL = CreateObject("Excel.Application")

Do Until rstVin.EOF


    strVin = rstVin!VIN

    If TableExists("tbl_Temp") Then _
	Currentdb.execute "Drop Table tbl_Temp;"


    DoCmd.RunSQL ("SELECT tbl_Data.* INTO tbl_Temp FROM tbl_Data WHERE [tbl_Data.Value]= " & "'" & strVin & "'")
    DoCmd.TransferSpreadsheet acExport, 10, "tbl_Temp", "Template location", False, "Data_Temp!" 'EXPORT TO EXCEL FILE


    With XL

        .Workbooks.Open "Template Location"
        'Me.Refresh
        'Me.Repaint

	.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:="Export Location" & strValue & ".pdf"
	Sleep 1000 'pause for 1 secs

	.ActiveWorkbook.Close (False)
    End With


    rstVin.MoveNext
    Me.Repaint

    intCounter = intCounter + 1

    txtRunSum.Value = intCounter
    txtComplete.Value = Format(intCounter / intRecCount, "Percent")
    Me.Recalc

Loop

XL.Quit
Set XL=Nothing

put this in Standard Module:

Option Compare Database
Option Explicit

#If VBA7 Then
        Private Declare PtrSafe Sub Sleep Lib "Kernel32" _
            (ByVal dwMilliseconds As Long)
#Else
    Private Declare Sub Sleep Lib "Kernel32" _
        (ByVal dwMilliseconds As Long)

#End If


public function TableExists(strTable as string) as boolean
	dim td as tabledef
	on error resume next
	set td=currentdb.tabledefs(strtable)
	TableExists= (err.number=0)
	set td=nothing
End Function

 

[mikewhite2018]

Hey!

I faced the similar problem with MS Access to convert XLS to PDF. Well i used Free Online Converter tool to convert XLS to PDF (onlineconvertfree.com/convert-format/xls-to-pdf/) file and it turned out to be the best solution. No need to download any software. Its available online and converts instantly. Also it supports many other formats like XLS to CSV

 

[Pat Hartman]

I don't understand why you are first creating a spreadsheet if what you really want is a PDF. Why not create an Access report that looks like the certificate and just output it as a PDF?