VBA Site contains VBA code to create macros in WORD EXCEL ACCESS OUTLOOK

 

In this case codes below allow to mass import text or excel files do the table in Access

1) You need to have table in Access with headers as excel or text file has

a) the easiest way to create table is manually import first excel or csv file,

* if you created table just delete manually imported data

b) if you import text file, it is also important to save specification - in the case below I saved it  as 'ImportSpecification'

c) add manually last column - we place the name of filename there (in my case below I named last column "File_name"

 

1) Mass import of excel files

2) Mass import of excel files picked from file.dialog

3) Mass import of text files

 

1) Mass import of excel files

 

Sub import()

Dim myfile

Dim mypath

mypath = "C:\YourFolder\" 'insert name of your folder where files to be imported are stored

ChDir (mypath)

myfile = Dir(mypath & "FIlename_*.xlsx") 'it will pick all xlsx files which have names starting from "Filename_"

Do While myfile <> ""

If myfile Like "FIlename_*.xlsx" Then

DoCmd.TransferSpreadsheet acImport, TableName:="NameOfMyTableInAccess", FileName:=mypath & myfile, HasFieldNames:=True

strsql = "UPDATE NameOfMyTableInAccess SET NameOfMyTableInAccess.File_name = '" & myfile & "' " & "WHERE (((NameOfMyTableInAccess.File_name) Is Null));" '"File_name" is a name of column which I added to insert name of the imported file

CurrentDb.Execute strsql

DoCmd.RunSQL "UPDATE NameOfMyTableInAccess SET NameOfMyTableInAccess.[File_name] = '" & myfile & "' WHERE (((NameOfMyTableInAccess.File_name) Is Null));" 'works also instead of strsql command

End If

myfile = Dir()

Loop

End Sub

 

2) Mass import of excel files picked from file.dialog

 

Sub import()

Dim f As Object

Set f = Application.FileDialog(3)

f.AllowMultiSelect = True

f.Show

For i = 1 To Application.FileDialog(3).SelectedItems.Count

strPath = Application.FileDialog(3).SelectedItems(i)

DoCmd.TransferSpreadsheet acImport, TableName:="YourTableName", FileName:=strPath, HasFieldNames:=True

strsql = "UPDATE YourTableName SET YourTableName.File_name = '" & strPath & "' " & "WHERE (((YourTableName.File_name) Is Null));" '"File_name" is a name of column which I added to insert name of the imported file

CurrentDb.Execute strsql

Next i

End Sub

 

3) Mass import of text files

 

Sub import()

Dim myfile

Dim mypath

mypath = "C:\YourFolder\"

ChDir (mypath)

myfile = Dir(mypath & "Filename_*.CSV")

Do While myfile <> ""

If myfile Like "Filename_*.CSV" Then

DoCmd.TransferText acImportDelim, SpecificationName:="ImportSpecification", TableName:="YourTableName", FileName:=mypath & myfile, HasFieldNames:=False

'ImportSpecification - it's a saved specification of import created during 1st manually imported txt file, while table was created

strsql = "UPDATE NameOfMyTableInAccess SET NameOfMyTableInAccess.File_name = '" & myfile & "' " & "WHERE (((NameOfMyTableInAccess.File_name) Is Null));"

CurrentDb.Execute strsql

End If

myfile = Dir()

Loop



Dodaj komentarz






Dodaj

© 2013-2024 PRV.pl
Strona została stworzona kreatorem stron w serwisie PRV.pl