Forum Discussion

orione1943's avatar
orione1943
Copper Contributor
Mar 04, 2022

wb.SaveAs CurrentProject.Path & nomefile

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

access
office 365

4 Replies

Sort By
  • Karl_Donaubauer's avatar
    Karl_Donaubauer
    MVP
    Mar 04, 2022

    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

    • orione1943's avatar
      orione1943
      Copper Contributor
      Mar 06, 2022
      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, 😎 = 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
    • orione1943's avatar
      orione1943
      Copper Contributor
      Mar 04, 2022

      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, 😎 = 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

      • orione1943's avatar
        orione1943
        Copper Contributor
        Mar 06, 2022

        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, 😎 = 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

Resources