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
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