wb.SaveAs CurrentProject.Path & nomefile

[orione1943]

Quando si apre il file spedizioni dalla maschera cliccare sul pulsante

Il codice apre una cartella excel di nome” Modello DDT.xlsx” e scarica i record contenuti in Set rs = CurrentDb.OpenRecordset("Articoli", DAO.dbOpenDynaset) nella tabella ARTICOLI  nel foglio di nome Set ws = wb.Worksheets("RIGHE DOCUMENTO") e  alla fine dovrebbe salvare la cartella con nome wb.SaveAs CurrentProject.Path & nomefile.

Quando il codice esegue l’istruzione  wb.SaveAs chiude il database SPEDIZIONI e l’errore non viene neppure intercettato

[#2]

Salve,

Non so cosa stia succedendo nel tuo database, ma sei sicuro che

wb.SaveAs CurrentProject.Path & filename

ha la stringa corretta?

Secondo il tuo codice, il valore di filename viene dalla riga:

nomefile = "Spedizione_" & j & "_" & giorno & mese & anno

Allora con
CurrentProject.Path & filename
mancano il backslash \ dopo Path e l'estensione per il file alla fine.

Forse il comportamento cambierà se correggi questo.

Servus
Karl
Access News
Access DevCon

[#3]

@Karl Donaubauer 

ho corretto nomefile ma mi da sempre lo stesso errore:mi sbatte fuori

Non mi permette di allegare il database.

Ti scrivo 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 DDT.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, 8) = rs("iva")
'prossimo record
rs.MoveNext
Loop
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
gestione_errori:
MsgBox Err.Number & ": " & Err.Description
Resume Next

End Sub

Buona giornata

[#4]

Grazie dei tuoi efficaci suggerimenti

Posto il codice

Private Sub Esporta_Click()
' esporta articoli in una cartella di excel
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, M_sped As Long
On Error GoTo gestione_errori
Dim dbs As Database, rst As Recordset, qdf As QueryDef, strsql As String
Set dbs = CurrentDb
'trovo il numero spedizione dalla Tabella Articoli
strsql = "SELECT Articoli.Numero_Spedizione FROM Articoli GROUP BY Articoli.Numero_Spedizione;"
Set qdf = dbs.CreateQueryDef("", strsql)
Set rst = qdf.OpenRecordset
M_sped = rst!Numero_Spedizione
'controllo se il campo 'esportata = False se si messaggio
strsql = "PARAMETERS sped Bit;" & _
"SELECT Spedizioni.Numero_spedizione, Spedizioni.Esportata " & _
"FROM spedizioni WHERE (((Spedizioni.Numero_spedizione)=[sped]) AND ((Spedizioni.Esportata)=False));"
Set qdf = dbs.CreateQueryDef("", strsql)
qdf.Parameters!sped = M_sped
Set rst = qdf.OpenRecordset
If rst.EOF() Then
MsgBox " La tabella è già stata esportata!", vbInformation
Exit Sub
End If
anno = Year(Date)
mese = Month(Date)
giorno = Day(Date)
nomefile = "Spedizione_" & Numerospedizione & "_" & giorno & mese & anno & ".xlsx"
'apre excel
Set ex = New Excel.Application
ex.Visible = True 'metti false se non vuoi vedere excel a video
'Crea prima la cartella "di lavoro" dal modello:
VBA.FileCopy CurrentProject.Path & "\modello DDT.xlsx", CurrentProject.Path & "\" & nomefile
Set wb = ex.Workbooks.Open(CurrentProject.Path & "\" & nomefile)
'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, 8) = 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
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
rst.Close

'cancella variabili oggetto
Set rs = Nothing
Set ex = Nothing
Set wb = Nothing
Set ws = Nothing
GoTo fine
gestione_errori:
MsgBox Err.Number & ": " & Err.Description
fine:
End Sub

Funziona

Buona domenica

Gianmario

[#5]

Ho camiato l'approcio e funziona
Grazie
Posto il codice:
Private Sub Esporta_Click()
' esporta articoli in una cartella di excel
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, M_sped As Long
On Error GoTo gestione_errori
Dim dbs As Database, rst As Recordset, qdf As QueryDef, strsql As String
Set dbs = CurrentDb
'trovo il numero spedizione dalla Tabella Articoli
strsql = "SELECT Articoli.Numero_Spedizione FROM Articoli GROUP BY Articoli.Numero_Spedizione;"
Set qdf = dbs.CreateQueryDef("", strsql)
Set rst = qdf.OpenRecordset
M_sped = rst!Numero_Spedizione
'controllo se il campo 'esportata = False se si messaggio
strsql = "PARAMETERS sped Bit;" & _
"SELECT Spedizioni.Numero_spedizione, Spedizioni.Esportata " & _
"FROM spedizioni WHERE (((Spedizioni.Numero_spedizione)=[sped]) AND ((Spedizioni.Esportata)=False));"
Set qdf = dbs.CreateQueryDef("", strsql)
qdf.Parameters!sped = M_sped
Set rst = qdf.OpenRecordset
If rst.EOF() Then
MsgBox " La tabella è già stata esportata!", vbInformation
Exit Sub
End If
anno = Year(Date)
mese = Month(Date)
giorno = Day(Date)
nomefile = "Spedizione_" & Numerospedizione & "_" & giorno & mese & anno & ".xlsx"
'apre excel
Set ex = New Excel.Application
ex.Visible = True 'metti false se non vuoi vedere excel a video
'Crea prima la cartella "di lavoro" dal modello:
VBA.FileCopy CurrentProject.Path & "\modello DDT.xlsx", CurrentProject.Path & "\" & nomefile
Set wb = ex.Workbooks.Open(CurrentProject.Path & "\" & nomefile)
'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, 8) = 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
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
rst.Close

'cancella variabili oggetto
Set rs = Nothing
Set ex = Nothing
Set wb = Nothing
Set ws = Nothing
GoTo fine
gestione_errori:
MsgBox Err.Number & ": " & Err.Description
fine:
End Sub
Buona domenica