Forum Discussion
wb.SaveAs CurrentProject.Path & nomefile
Posto il codice
Private Sub Esporta_Click()
Dim rs As DAO.Recordset
Dim ex As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim i As Integer, PERCORSO As String, anno As Integer, mese As Integer, giorno As Integer, j As Integer
On Error GoTo gestione_errori
'controllo se il campo 'esportata = False se si messaggio ed exi sub
'PERCORSO = "E:\CORSI\Corsi2022\Scainelli Giacomo\"
anno = Year(Date)
mese = Month(Date)
giorno = Day(Date)
j = 1
nomefile = "\Spedizione_" & j & "_" & giorno & mese & anno & ".xlsx"
'apre excel
Set ex = New Excel.Application
ex.Visible = True 'metti false se non vuoi vedere excel a video
' Set Wb = exlApp.Workbooks.Add(CurrentProject.Path & "\Modello.xls")
'apre il file xlsx
'Set wb = ex.Workbooks.Open(PERCORSO & "modello.xlsx")
Set wb = ex.Workbooks.Open(CurrentProject.Path & "\modello DDT.xlsx")
'seleziona il foglio 1
Set ws = wb.Worksheets("RIGHE DOCUMENTO")
'apre un recordset con la tabella da esportare
Set rs = CurrentDb.OpenRecordset("Articoli", DAO.dbOpenDynaset)
i = 1
'loop sui record
Do Until rs.EOF
'aggiorna un contatore
i = i + 1
'imposta la colonna A e B e C per la riga = i
ws.Cells(i, 1) = rs("Codice_articolo")
ws.Cells(i, 2) = rs("Descrizione")
ws.Cells(i, 3) = rs("Quantità")
ws.Cells(i, 4) = rs("prezzo")
ws.Cells(i, 😎 = rs("iva")
'prossimo record
rs.MoveNext
Loop
MsgBox "The current database is located at " & Application.CurrentProject.Path & "."
wb.SaveAs CurrentProject.Path & nomefile
'wb.SaveAs CurrentProject.Path & nomefile
'wb.SaveAs PERCORSO & nomefile
'Salva file
wb.Save
'Chiude Recordset
rs.Close
'chiude file
wb.Close
'esce da excel
ex.Quit
'Dim dbs As Database, rst As Recordset, qdf As QueryDef, strsql As String
'Set dbs = CurrentDb
'strsql = "PARAMETERS numsped Long;" & _
'"SELECT Spedizioni.Numero_spedizione, Spedizioni.esportata FROM spedizioni " & _
'"WHERE (((Spedizioni.Numero_spedizione)=[numsped]));"
'Set qdf = dbs.CreateQueryDef("", strsql)
'qdf.Parameters!numsped = 1
'Set rst = qdf.OpenRecordset
'rst.Edit
'rst!Esportata = True
'rst.Update
'
'cancella variabili oggetto
Set rs = Nothing
Set ex = Nothing
Set wb = Nothing
Set ws = Nothing
Exit Sub
gestione_errori:
MsgBox Err.Number & ": " & Err.Description
End Sub
Con office 365 all'istruzione wb.SaveAs CurrentProject.Path & nomefile mi butta fuori invece con office 2016 intercette l'errore " 9 indice non incluso nell'intervall"
mentre ad un mio amico esegue la routine perfettamente
sono sconcertato
if you keep on encountering error when using SaveAs...
you might as well revised the step of Creating workbook from your Template:
1. Create the "work" workbook from your template first:
VBA.FileCopy CurrentProject.Path & "\modello DDT.xlsx", CurrentProject.Path & "\" & nomefile
now directly open the nomefile and update it:
Set wb = ex.Workbooks.Open(CurrentProject.Path & "\" & nomefile)
'seleziona il foglio 1
Set ws = wb.Worksheets("RIGHE DOCUMENTO")'rest of code here
...
...
'Close and Save changes
wb.Close, True
2 Replies
- arnel_gpIron Contributor
if you keep on encountering error when using SaveAs...
you might as well revised the step of Creating workbook from your Template:
1. Create the "work" workbook from your template first:
VBA.FileCopy CurrentProject.Path & "\modello DDT.xlsx", CurrentProject.Path & "\" & nomefile
now directly open the nomefile and update it:
Set wb = ex.Workbooks.Open(CurrentProject.Path & "\" & nomefile)
'seleziona il foglio 1
Set ws = wb.Worksheets("RIGHE DOCUMENTO")'rest of code here
...
...
'Close and Save changes
wb.Close, True
- orione1943Copper ContributorOk
Grazie della tua disponibilità e della tua competenza
Gianmario