• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 77
  • Last Modified:

automate tasks to create an accdb file and import a csv file in to it

How can i do this ? Does anyone have a script that import a csv into a accdb
0
armasmike
Asked:
armasmike
5 Solutions
 
Bill PrewCommented:
So you need to create a new Access database, then import a CSV?  Or do you have a database already with a table and columns defined, that you want to import data into?  Can you provide a sample of the CSV?  Additional info would help experts comment on this...

~bp
0
 
PatHartmanCommented:
Script?  Importing a .csv is a single statement.

docmd.TransferText acImportDelim,"specification name", "table name", "filename", true

If you use the wizard to import the csv once manually, you can create a specification that properly defines the columns.  Then when automating the import, you refer to the name of the saved spec.  "table name" is the name of the imported table, "file name" is the name of the source file including its full path, and the last argument is true or false depending on whether the first row contains column names.

BTW, you don't have to import the .csv to use it.  You can specify acLinkDelim to link to the .csv rather than importing it.
0
 
armasmikeAuthor Commented:
Yes create a  new Access database, then import a CSV

I have added a text csv file
0
A Cyber Security RX to Protect Your Organization

Join us on December 13th for a webinar to learn how medical providers can defend against malware with a cyber security "Rx" that supports a healthy technology adoption plan for every healthcare organization.

 
Helen FeddemaCommented:
In a newly created database, there would be no saved specifications, so importing the csv might be problematic.  How about creating a database with the specification, tested to make sure it imports the csv correctly,  with a procedure to run the import, then just making a copy of the database and running the code?

Here is some code to open a database and run a procedure (among other actions):

Public Sub OpenAnotherDatabase()
'Created by Helen Feddema 14-Feb-2010
'Last modified by Helen Feddema 14-Feb-2010

   Dim appAccess As New Access.Application
   Dim dbe As DAO.DBEngine
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim strDBNameAndPath As String
   Dim strSQL As String
   
   'Change to your db name and path
   strDBNameAndPath = "C:\Users\Helen Feddema Home\Documents\Access 2010 Databases\New Style Main Menu.accdb"
   appAccess.Visible = True
   appAccess.OpenCurrentDatabase FilePath:=strDBNameAndPath, _
      exclusive:=False
      
   'Run a procedure
   'appAccess.Run "PrintOrdersReport"
   
   'Run a macro
   'appAccess.DoCmd.RunMacro "mcrPrintOrdersReport"
   
   'Run an action query
   'appAccess.DoCmd.OpenQuery "qryDeleteSomeOrders"
   
   'Run SQL code
   strSQL = "DELETE tblOrders.ShippedDate FROM tblOrders WHERE ShippedDate = #8/4/1994#;"
   Debug.Print "SQL string: " & strSQL
   'appAccess.DoCmd.RunSQL strSQL
   
   'Iterate through a recordset
   Set dbe = appAccess.DBEngine
   Set dbs = dbe.OpenDatabase(strDBNameAndPath)
    
   Set rst = dbs.OpenRecordset("tblCategories")
   Do Until rst.EOF
      Debug.Print rst![CategoryName]
      rst.MoveNext
   Loop
   rst.Close
    
   Set dbs = Nothing
   Set appAccess = Nothing
   
End Sub

Open in new window

0
 
Helen FeddemaCommented:
You can copy a database using this code (with the variables set for your needs):

   Dim fso As Scripting.FileSystemObject
   
   Set fso = CreateObject("Scripting.FileSystemObject")
   fso.CopyFile strDatabaseToCopy, strSaveName

Open in new window


This code requires setting a reference to the Scripting Runtime Library in the References dialog.
0
 
PatHartmanCommented:
Here's a sample where I create an archive and export tables to it using queries to select the audit that is being archived.
Sub CreateNewMDBFile(PathName As String, DBName As String)

    Dim ws As Workspace
    Dim db As Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strFileName As String
    Dim strPath As String
    Dim strDatapath As String


On Error GoTo Proc_Err
    'Get default Workspace
    Set ws = DBEngine.Workspaces(0)

    If PathName & "" = "" Then
        MsgBox "Please select destination folder for archive database.", vbOKOnly + vbInformation
        Exit Sub
    Else
        strPath = PathName
        If Right(strPath, 1) = "\" Then
        Else
            strPath = strPath & "\"
        End If
    End If

    If DBName & "" = "" Then
        MsgBox "Please enter db name for archive database.", vbOKOnly + vbInformation
    Else
        strFileName = strPath & DBName
    End If
    'Make sure there isn't already a file with the name of the new database
    If Dir(strFileName) <> "" Then Kill strFileName

    'Create a new mdb file
    Set db = ws.CreateDatabase(strFileName, dbLangGeneral)

    Call ExportTables(strFileName)
    
    Call SetStartupProperties(strFileName)
    
    MsgBox "Export Complete." & vbCr & " Your Archive is: " & vbCr & vbCr & strFileName, vbOKOnly + vbInformation
    
    db.Close
    Set db = Nothing
Proc_Exit:
    Exit Sub
Proc_Err:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & "--" & Err.Description, vbCritical
            Resume Proc_Exit
    End Select
End Sub

Public Sub ExportTables(strFileName)
    'Export data to new mdb file

    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportReviewStatus", "tblReviewStatus", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportStates", "tblStates", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportStatus", "tblStatus", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportRoles", "tblRoles", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportUserRoles", "tblUserRoles", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportUsers", "tblUsers", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportDocuments", "tblDocuments", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportAuditParms", "tblAuditParms", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportMembers", "tblMembers", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportRefDocs", "tblRefDocs", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportComments", "tblComments", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportDependents", "tblDependents", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportHelpComments", "tblHelpComments", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportListValues", "tblListValues", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportLtrSent", "tblLtrSent", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "qExportVerificationPhase", "tblVerificationPhase", False
    DoCmd.TransferDatabase acExport, "Microsoft Access", strFileName, acTable, "tblTPA", "tblTPA", False
End Sub


Public Function SetStartupProperties(strDB)
    Dim dbs As DAO.Database
    Dim prp As Object
    Dim strTitle As String

    Const PROPERTY_NOT_FOUND As Integer = 3270
    Const TEXT_TYPE As Integer = 10  ' Equivalent to DAO dbText data type.
    Const BOOL_TYPE As Integer = 1   ' Equivalent to DAO dbBoolean data type.
    Const LONG_TYPE As Integer = 4   ' Equivalent to DAO dbLong data type.
    
    On Error GoTo ErrorHandler
  
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strDB)
    strTitle = "Dependent Eligibility AuditorĀ®TM    Proprietary Information"

    ' Try to set the property. If it fails, the property does not exist.
    On Error Resume Next
    dbs.Properties("AppTitle") = strTitle
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AppTitle", TEXT_TYPE, strTitle)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
                Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
 

    dbs.Properties("AllowFullMenus") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowFullMenus", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowShortcutMenus") = True
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowShortcutMenus", BOOL_TYPE, True)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("StartupShowDBWindow") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("StartupShowDBWindow", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBuiltInToolbars") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBuiltInToolbars", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowToolbarChanges") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowToolbarChanges", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBypassKey") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBypassKey", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBreakIntoCode") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBreakIntoCode", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select

''    dbs.Properties("AllowSpecialKeys") = False
''        Select Case Err.Number
''            Case PROPERTY_NOT_FOUND
''            ' Create the new property.
''                Set prp = dbs.CreateProperty("AllowSpecialKeys", BOOL_TYPE, False)
''                dbs.Properties.Append prp
''                Resume Next
''            Case 0
''               ' Refresh the title bar to reflect the change.
''                Application.RefreshTitleBar
''            Case Else
''                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly+vbInformation
''                GoTo ExitLine
''        End Select

    Call SetMDBAppIcon
    
ExitLine:
   dbs.Close
   Set dbs = Nothing
   Set prp = Nothing
   Exit Function

ErrorHandler:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
            Resume ExitLine
    End Select
End Function

Open in new window

0

Featured Post

 The Evil-ution of Network Security Threats

What are the hacks that forever changed the security industry? To answer that question, we created an exciting new eBook that takes you on a trip through hacking history. It explores the top hacks from the 80s to 2010s, why they mattered, and how the security industry responded.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now