Forum Discussion

orione1943's avatar
orione1943
Copper Contributor
Mar 04, 2022
Solved

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

  • orione1943 

     

    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_gp's avatar
    arnel_gp
    Iron Contributor

    orione1943 

     

    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

     

     

     

     

    • orione1943's avatar
      orione1943
      Copper Contributor
      Ok
      Grazie della tua disponibilità e della tua competenza
      Gianmario

Resources