I am hoping to find a way to help this code run faster; so this is the path im following to try and achieve this -
current time - 23 seconds, most of it opening & closing files.
So I am attempting to pull data from files without opening them. I've seen Microsoft.ACE.OLEDB.12.0 but I have not idea how to use it to get the entire sheet, warts and all.
I've seen a lot of solutions that pull data from cells and gets sheet names - I want my entire sheet, all objects on that sheet, its headers, footers, everything.
This is the macro I'd like to apply it to:
Sub DirPDF_Long_Sections(LongFolderPath As String)
' ####################################################################################
' # INTRO
'-------------------------------------------------------------------------------------
' Purpose
' This procedure assists the user to put all long sections from a folder into one
' PDF file. This makes it convieniet to share the long sections & print them.
'
' THIS PROCEDURE USES DIR instead of FSO
'
' ####################################################################################
' # DECLAIRATIONS
'-------------------------------------------------------------------------------------
' OBJECTS
Dim LongFolder As String
Dim LongFile As String
Dim OpenLong As Workbook
Dim ExportWB As Workbook
'Dim FileSystemObj As New FileSystemObject
'-------------------------------------------------------------------------------------
' VARIABLES
Dim count As Long
Dim DefaultPrinter As String
Dim DefaultSheets As Variant
Dim FirstSpace As Long
Dim LastSpace As Long
Dim start_time, end_time
' ####################################################################################
' # PROCEDURE CODE
'-------------------------------------------------------------------------------------
' optimise speed
start_time = Now()
Application.ScreenUpdating = False
'-------------------------------------------------------------------------------------
' Print the Files in the Folder:
DefaultSheets = Application.SheetsInNewWorkbook '// save default setting
Application.SheetsInNewWorkbook = 1 '// create a one worksheet workbook
Set ExportWB = Workbooks.Add
Application.SheetsInNewWorkbook = DefaultSheets '// re-set application to default
LongFile = Dir(LongFolderPath & "\*PipeLongSec*", vbNormal)
While LongFile <> vbNullString '// loop through all the files in the folder
FirstSpace = InStr(1, LongFile, " ") '// record position of first space character
LastSpace = InStr(FirstSpace + 1, LongFile, " ") '// record position of last space character
Set OpenLong = Workbooks.Open(LongFile) '// open the file
OpenLong.Sheets("Long Sections").Copy After:=ExportWB.Sheets(ExportWB.Sheets.count)
'// copy sheet into export workbook
ExportWB.Sheets(ExportWB.Sheets.count).Name = Mid(LongFile, FirstSpace + 1, LastSpace - FirstSpace - 1)
'// rename sheet we just moved to its pipe number
OpenLong.Close '// close the file
LongFile = Dir() '// get next file
Wend
'-------------------------------------------------------------------------------------
' Delete the other worksheet in the temporary workbook
Application.DisplayAlerts = False
ExportWB.Sheets("Sheet1").Delete
Application.DisplayAlerts = True
'-------------------------------------------------------------------------------------
' Send Workbook to PDF - in save location
ExportWB.ExportAsFixedFormat xlTypePDF, LongFolderPath & "\" & "LongSectionCollection " & Replace(Date, "/", "-")
ExportWB.Close SaveChanges:=False
'#####################################################################################
'# END PROCEDURE
Application.ScreenUpdating = True
Set OpenLong = Nothing
end_time = Now()
MsgBox (DateDiff("s", start_time, end_time))
End Sub