Risolto! ora funziona tutto. Per chi volesse dare un'occhiata il codice è qui
tutto ciò serve ad aggiornare i file excel che sono collegati a tabelle access.
questo codice controlla solo se ci sono divergenze nei campi "data/ora modifica", devo solo aggiungere la parte per aggiungere i record nuovi non presenti e cancellare le righe dei record che cancello su access
Public Function ExportExcel()
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim db As DAO.Database, Tbf As DAO.TableDef, RstUpdt As DAO.Recordset
Dim Worksheetname As String, TbEx As String, FldName As String, ColName As String
Dim FldNum As Integer, i As Integer, RowNum As Long
Dim FldValue As Variant
Set db = CurrentDb
On Error Resume Next
Set xlx = GetObject(, "Excel.application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.application")
End If
Err.Clear
On Error GoTo 0
xlx.Visible = False ' se setto vero mi apre il file excel in questione
For Each Tbf In db.TableDefs
TbEx = Tbf.Name & "ex"
If ifTableExists(TbEx) Then
FldName = GetIndex(Tbf)
Debug.Print (FldName)
Set xlw = xlx.Workbooks.Open("C:\Users\diego\OneDrive - Indipendente\Lavoro\Informatica\Gestionale\Dati\" & Tbf.Name & ".xlsx")
Set xls = xlw.worksheets(Tbf.Name)
Set RstUpdt = db.OpenRecordset("SELECT [" & Tbf.Name & "].* FROM [" & TbEx & "] INNER JOIN [" & Tbf.Name & "] ON [" & TbEx & "].[" & FldName & "] = [" & Tbf.Name & "].[" & FldName & "] " & vbCrLf & _
"WHERE ((([" & Tbf.Name & "].[Data modifica])>[" & TbEx & "].[data modifica]));")
RstUpdt.MoveLast
Debug.Print (RstUpdt.RecordCount)
'Set RstUpdt = db.OpenRecordset("SELECT * FROM " & Tbf.Name)
If RstUpdt.RecordCount > 0 Then
RstUpdt.MoveFirst
FldNum = RstUpdt.Fields.Count
ColName = GetExcelColumn(FldNum, xls, FldName)
Debug.Print (ColName)
Do While Not RstUpdt.EOF Or RstUpdt.BOF
Debug.Print (RstUpdt.Fields(FldName))
FldValue = RstUpdt.Fields(FldName)
Set xlc = xls.Range(ColName & ":" & ColName).Find(FldValue) 'Rstupdt.Fields(FldName))
Debug.Print (xlc)
RowNum = xlc.Row
Debug.Print (RowNum)
For i = 0 To FldNum - 1
'xlc.Offset(0, ColNum).Value = RstUpdt.Fields(ColNum).Value
xlc.Offset(0, i).Value = RstUpdt.Fields(i).Value
Debug.Print (xlc.Offset(0, i).Value)
Debug.Print (RstUpdt.Fields(i).Value)
Next i
RstUpdt.MoveNext
Loop
End If
xlw.Save
xlw.Close
End If
Next Tbf
Set xlc = Nothing
Set xls = Nothing
Set xlw = Nothing
xlx.Quit ' se esiste l'applicazione excel la chiude
Set xlx = Nothing
End Function
Public Function ifTableExists(tblName As String) As Boolean 'vedere se una tabella esiste
If DCount("[Name]", "MSysObjects", "[Name] = '" & tblName & "'") = 1 Then
ifTableExists = True
End If
End Function
Public Function GetIndex(Tbf As DAO.TableDef) As String
Dim Idx As Index
For Each Idx In Tbf.Indexes
On Error Resume Next
If Idx.Primary Then GetIndex = Replace(Idx.Fields, "+", "")
Next Idx
End Function
Public Function GetExcelColumn(FieldCount As Integer, WrkSht As Excel.Worksheet, FieldName As String) As String
Dim i As Integer, ExecelApp As Object
For i = 1 To FieldCount 'cerco dalla prima colonna della prima riga fino al numero di campi della tabella access se il nome campo access è uguale all'intestazione colonna di excel
If WrkSht.Cells(1, i).Value = FieldName Then
GetExcelColumn = (Left(Right(WrkSht.Cells(1, i).Address, Len(WrkSht.Cells(1, i).Address) - 1), InStr(WrkSht.Cells(1, i).Address, "$")))
Exit For
End If
Next i
End Function