automatiquement les requêtes et de les convertir accès db tableau excel à l'aide de vbs

J'ai une base de données Access. Je voudrais automatiquement la requête de la table Data_01 et d'exporter les résultats dans une feuille de calcul Excel à l'aide d'ADO en VBScript sur une base quotidienne. À l'heure actuelle mes compétences en ADO font défaut.

  1. J'ai une date de colonne de temps que je voudrais sélectionner des éléments d'hier et d'aujourd'hui. Dans une interface graphique de requêtes seraient les critères Between Date() And Date()-1
  2. J'ai un PartNumber colonne que je voudrais sélectionner un numéro de série spécifique. Dans une interface graphique de requêtes seraient les critères Series 400
  3. Je voudrais ensuite sélectionner d'autres colonnes basées sur les critères énoncés aux points 1. et 2.
  4. Je voudrais obtenir la ligne d'en-tête des colonnes aussi.

Je suis actuellement à l'exportation de la totalité de la table vers Excel, puis à l'aide d'un VBScript pour sélectionner les colonnes que je veux et puis la suppression de toutes les données, puis d'ajustement automatique des colonnes pour mon dernier fichier de sortie. Cela semble être un peu le processeur, et exige beaucoup de temps.

OriginalL'auteur | 2009-02-19

  1. 1

    Avez-vous essayé les fonctions intégrées dans Excel pour importer les données? Je n'ai pas de version anglaise d'Excel, donc je ne vais pas vous guider à eux, mais je pense que le menu est appelé "Données".

    OriginalL'auteur svinto

  2. 1

    Voici quelques exemples de VBScript

    Dim cn 
Dim rs

strFile = "C:\Docs\LTD.mdb"

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM tblTable " _
& "WHERE CrDate Between Now() And Date()-1 " _
& "AND OtherField='abc' " _
& "AND PartNumber=1 " _
& "ORDER BY CrDate, PartNumber"

rs.Open strSQL, cn

Set xl = CreateObject("Excel.Application")
Set xlBk = xl.Workbooks.Add

With xlbk.Worksheets(1)
    For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs.Fields(i).Name
    Next

    .Cells(2, 1).CopyFromRecordset rs
    .Columns("B:B").NumberFormat = "m/d/yy h:mm"
End With

xl.Visible=True

    OriginalL'auteur Fionnuala

  3. 0

    Ma première réaction est de faire ce qui suit:

    1. Créer un objet de requête dans MS Access qui juge que les données que vous souhaitez exporter [Fenêtre de Base de données -> Requêtes -> Nouveau (utiliser le GUI builder pour l'instant)]
    2. Créer une macro qui exporte la requête vers un fichier Excel. Je parle plus que ici. Vous pouvez le faire en VBA... de nombreux dirais que c'était plus "pure" (j'ai des macros); mais quelle que soit la flotte votre bateau.
    3. Configurer une macro autoexec (cela va s'exécuter automatiquement lors de la MS Access s'ouvre) qui s'exécute à l'exportation de la macro que vous venez de créer, puis se ferme MS Access (vous pouvez la remplacer mon maintenez la touche maj enfoncée tandis que l'Accès est en cours de chargement). Ce serait un peu mieux également de créer une MS Access fichier à exécuter ces opérations sans incidence sur l'original MS Access fichier, tout en créant des liens de la table à l'original.
    4. Définir une Tâche Planifiée pour ouvrir l'Accès MS fichier une fois par jour.
    En fait, j'ai 30 automatisation des différentes machines de production que sont la création d'similaire indivdual bases de données sur un roulement. Ils remplacent-delà de 24 000 dossiers. J'ai une heure de temps d'arrêt par jour dans le milieu de la nuit pour prendre un instantané à toutes et processus les jours de données.
    C'est tout simplement d'une question d'échelle et le script de la récolte de données à partir de toutes les 30 Amm.

    OriginalL'auteur BIBD

  4. 0

    Si vous n'avez pas Excel, vous pouvez accéder à un xls avec ADO comme cette

    
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const strDB = "" 'Location of Database file
Const strXLS = "" 'Location of spreadsheet


Set objAccessConnection = CreateObject("ADODB.Connection")
objAccessConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & strDB
Set objExcelConnection = CreateObject("ADODB.Connection")
objExcelConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strXLS & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
Set objAccessRecordset = CreateObject("ADODB.Recordset")
Set objExcelRecordSet = CreateObject("ADODB.Recordset")

strAccessQuery = "SELECT * FROM Data_01 WHERE PartNumberColumn = 'Series 400' AND DateColumn BETWEEN #" & Date -1 & "# AND #" & Date & "#"
objAccessRecordset.Open strAccessQuery, objAccessConnection, adOpenStatic, adLockOptimistic

strTable = "Sheet1$"
objExcelRecordSet.Open "Select * FROM [" & strTable & "]", objExcelConnection, adOpenStatic, adLockOptimistic, adCmdText

Do Until objAccessRecordset.EOF
   objExcelRecordSet.AddNew
   For i = 0 To objAccessRecordSet.Fields.Count - 1
       objExcelRecordset.Fields(i).Value = objAccessRecordset.Fields(i).Value
   Next
   objExcelRecordSet.Update
   objAccessRecordset.MoveNext
Loop

objExcelRecordset.Close
Set objExcelRecordset = Nothing
objAccessRecordset.Close
Set objAccessRecordset = Nothing
objAccessConnection.Close
Set objAccessConnection = Nothing

    La seule chose à surveiller est de s'assurer que les colonnes dans la feuille de calcul qui ont un titre dans la première rangée, sinon ce script pourrait échouer.

    EDIT:

    vous pouvez également écrire le jeu d'enregistrements à un .fichier csv.

    
Const adClipString = 2
Const ForWriting = 2
Const ForAppending = 8
Const strDB = "C:\Test.mdb"
Const strCSV = "C:\Test.csv"


Set objAccessConnection = CreateObject("ADODB.Connection")
objAccessConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & strDB

Set objAccessRecordset = CreateObject("ADODB.Recordset")

strAccessQuery = "SELECT * FROM Data_01 WHERE PartNumber = 'Series 400' AND TheDate BETWEEN #" & Date -1 & "# AND #" & Date & "#"
objAccessRecordset.Open strAccessQuery, objAccessConnection, adOpenStatic, adLockOptimistic

Set objCSV = CreateObject("Scripting.FileSystemObject").OpenTextFile(strCSV, ForAppending, True)
objCSV.Write objAccessRecordset.GetString(adClipString,,",",CRLF)

objCSV.Close
Set objCSV = Nothing
objAccessRecordset.Close
Set objAccessRecordset = Nothing
objAccessConnection.Close
Set objAccessConnection = Nothing

    Excel s'ouvre .les fichiers csv sans problème. L'inconvénient de cette méthode est Excel ne fait pas bien avec l'économie .les fichiers csv, mais dans excel le fichier csv peut être enregistré en tant que xls.

    OriginalL'auteur Tester101