Stuck on VBA / refreshing & saving excel sheets via MS access

[chally3]

Good morning everyone,

Can anyone help please, I have the VBA below in an access database which opens and closes some excel spreadsheets which we use to export from our works system (using microsft query) . I have pulled all this data into access to manipulate into reports we need. The excel sheets automatically refresh when you open them and update with the lastest data. & I was hoping the VBA below would do the same when we open our access database , by refreshing all the spreadsheets , saving and closing so access is up to date but this does not seem to be working.

Can anyone suggest what might be wrong with the VBA below?


Thank you kindly



Option Compare Database

Private Sub Form_Load()
' If UCase(nam) = "MARKC" Or UCase(nam) = "GINAW" Then
DoCmd.SetWarnings False
Dim tnam, tt, nam As String
Dim tdd, dd As Date

tdd = GetField("chk", "FROM chk ORDER BY chk DESC")
tnam = GetField("staff", "FROM chk ORDER BY chk DESC")

If tdd < Date Then
nam = Environ("UserName")
'dd = Now()

Dim xl_app As Object
Dim xl_worksheet As Object
Dim xl_workbook As Object
Set xl_app = CreateObject("Excel.Application")
Set xl_workbook = xl_app.Workbooks.Open("S:\Purchasing Share\Non acknowledged orders.xlsx")
Set xl_worksheet = xl_workbook.Worksheets(1)
xl_workbook.RefreshAll
xl_workbook.Close SaveChanges:=True



Set xl_app = CreateObject("Excel.Application")
Set xl_workbook = xl_app.Workbooks.Open("S:\Purchasing Share\KPIs\Ontime delivery.xlsx")
Set xl_worksheet = xl_workbook.Worksheets(1)
xl_workbook.RefreshAll
xl_workbook.Close SaveChanges:=True


Set xl_app = CreateObject("Excel.Application")
Set xl_workbook = xl_app.Workbooks.Open("S:\Purchasing Share\Approved Supplier List Latest.xlsx")
Set xl_worksheet = xl_workbook.Worksheets(1)
xl_workbook.RefreshAll
xl_workbook.Close SaveChanges:=True

Set xl_app = CreateObject("Excel.Application")
Set xl_workbook = xl_app.Workbooks.Open("S:\Purchasing Share\Parts to call off NEW.xlsx")
Set xl_worksheet = xl_workbook.Worksheets(1)
xl_workbook.RefreshAll
xl_workbook.Close SaveChanges:=True

Set xl_app = CreateObject("Excel.Application")
Set xl_workbook = xl_app.Workbooks.Open("S:\Purchasing Share\Planning validation\Copy of (111215) ROL Calc.xlsx")
Set xl_worksheet = xl_workbook.Worksheets(1)
xl_workbook.RefreshAll
xl_workbook.Close SaveChanges:=True




Set xl_app = Nothing


DoCmd.RunSQL "INSERT INTO CHK (CHK,STAFF) VALUES ('" & Now() & "' , '" & nam & "')"

Else
'MsgBox "hhhhhh"
End If

tdd = GetField("chk", "FROM chk ORDER BY chk DESC")
tnam = GetField("staff", "FROM chk ORDER BY chk DESC")
tt = Format(tdd, "MM/dd/yyyy hh:mm:ss")

UpLB.Caption = "Last updated on " + tt + " by " + tnam


DoCmd.SetWarnings True
End Sub


Function GetField(Field As String, SQL As String) As Variant
Dim z As Recordset
Set z = CurrentDb.OpenRecordset("SELECT " & Field & " " & SQL, dbOpenDynaset)
If Not z.EOF Then GetField = z.Fields(0) Else GetField = Null
z.Close
End Function

 

[xenou]

tdd is probably not less than date because you are retrieving a timestamp (i.e. now(), a date with time) but comparing to a date (i.e. date(), a date without a time). You don't need to recreate the xl_app each time, and I'd quit the xl_app to be clean with your housekeeping.

To clarify, if you get "2016-01-01 9:00 AM" as the date, it is not less than "2016-01-01 00:00:00" so your query would skip right over all the IF stuff on that condition.