AS
AS
VBA per Access
Tool per creare file in copia da un modello e relativa esportazione query
Il presente tool consente di creare n cartelle di Excel in copia di un determinato modello.
Su ciascuno di questi file viene esportata una query adeguatamente filtrata.
In allegato il tool ed un modello estrememente semplificato.
Scaricando i seguenti file accettate che vengono rilasciati così come sono, senza alcun tipo di garanzia.
Su ciascuno di questi file viene esportata una query adeguatamente filtrata.
In allegato il tool ed un modello estrememente semplificato.
Scaricando i seguenti file accettate che vengono rilasciati così come sono, senza alcun tipo di garanzia.
Codice
Public Function fnct_duplica(myModel As String)
On Error GoTo Err
Dim Vpath As String
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim rst As DAO.Recordset
Dim sqlStr_items As String
Dim sqlStr_item As String
Dim Vfile As String
Set fs = CreateObject("Scripting.FileSystemObject")
Vpath = Application.CurrentProject.Path
myModel = Vpath & "\" & myModel
Set db = CurrentDb
Set qdef = db.QueryDefs("myTempQuery")
sqlStr_items = "SELECT myKey FROM myItems;"
Set rst = db.OpenRecordset(sqlStr_items, dbOpenDynaset)
rst.MoveFirst
While Not rst.EOF
sqlStr_item = "SELECT * FROM myItems WHERE myKey = '" & rst!myKey & "';"
qdef.SQL = sqlStr_item
Vfile = Vpath & "\" & rst!myKey & "_myExcel.xlsx"
fs.CopyFile myModel, Vfile, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "myQuery", Vfile, , "base"
rst.MoveNext
Wend
MsgBox ("Esportazione terminata")
qdef.Close
db.Close
Exit Function
Err:
MsgBox Err.Description
Exit Function
End Function