Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

DB Access: Esportazione in Excel

19 views
Skip to first unread message

valentina ferrari

unread,
Apr 18, 2023, 8:53:26 AM4/18/23
to
Buongiorno,
Sto usando un DB in access nel quale c'è la possibilità di esportare in Excel su un file esistente.
Fino adesso mi serviva solo l'esportazione della tabella ingegneria, ma ora devo esportare anche quella relativa ai materiali.
Inserito c'è questo codice, di cui ho provato ad apportare delle modifiche per l'esportazione della seconda tabella Materiali.

Private Sub prova_Click()
Dim xlApp As Object, xlSheet As Object
Dim rs As Recordset, ExcelTargetRange As Object, FieldNum As Integer
Dim i As Long, j As Long, k As Long, TblIng, TblMat As String
Dim ExcelFileName As String, ExcelSheetING, ExcelSheetMAT As String
Dim ExcelStartCell As String
intRisposta = MsgBox("Vuoi ESPORTARE TUTTI I DATI IN EXCEL?", vbInformation + vbYesNo)
If intRisposta = vbNo Then
Response = acDataErrDisplay
Exit Sub
End If

' INGEGNERIA
If intRisposta = vbYes Then
TblIng = "P_Ingegneria"
FieldNum = 22
ExcelFileName = "C:\Users\PC\Desktop\Costi.xlsx"
ExcelSheetING = "Ingegneria"
ExcelStartCell = "A14"

Set db = CurrentDb
Set rs = db.OpenRecordset(TblIng, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(ExcelFileName)
Set ExcelTargetRange = xlSheet.Sheets(ExcelSheetING).Range(ExcelStartCell)
End If

' MATERIALI
If intRisposta = vbYes Then
Tblmat = "P_MAteriali"
FieldNum = 22
ExcelFileName = "C:\Users\PC\Desktop\Costi.xlsx"
ExcelSheetMat = "Materiali"
ExcelStartCell2 = "A14"

Set db = CurrentDb
Set rs = db.OpenRecordset(TblMat, dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(ExcelFileName)
Set ExcelTargetRange= xlSheet.Sheets(ExcelSheetMat).Range(ExcelStartCell2)
End If

Do
k = k + 1
If IsEmpty(ExcelTargetRange(k, 1)) Then
Exit Do
End If
Loop

Do Until rs.EOF
For i = 1 To FieldNum
ExcelTargetRange(k, i) = rs.Fields(i - 1)
Next
k = k + 1
rs.MoveNext
Loop

xlSheet.Close SaveChanges:=True

End Sub

Mi dà errore però nella riga "Set ExcelTargetRange= xlSheet.Sheets(ExcelSheetMat).Range(ExcelStartCell2)" relativa ai materiali...Probabilmente devo inserire un altro rs all'inizio ma non so bene come...qualcuno mi può aiutare?
Grazie
0 new messages