Solved

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

Posted on 2016-07-27
7
42 Views
Last Modified: 2016-10-07
How can i do this ? Does anyone have a script that import a csv into a accdb
0
Comment
Question by:armasmike
7 Comments
 
LVL 51

Assisted Solution

by:Bill Prew
Bill Prew earned 100 total points
ID: 41731277
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
 
LVL 34

Assisted Solution

by:PatHartman
PatHartman earned 200 total points
ID: 41731421
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
 

Author Comment

by:armasmike
ID: 41731559
Yes create a  new Access database, then import a CSV

I have added a text csv file
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 31

Assisted Solution

by:Helen_Feddema
Helen_Feddema earned 200 total points
ID: 41733312
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
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 200 total points
ID: 41733321
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
 
LVL 34

Assisted Solution

by:PatHartman
PatHartman earned 200 total points
ID: 41733450
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Synchronize a new Active Directory domain with an existing Office 365 tenant
The viewer will learn how to dynamically set the form action using jQuery.
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now