Vba code to import excel files Results

I routinely import excel files into my DB and then update the contents of existing tables. To do this programatically, I used the following code. I am not very confident user of VB so would like some help in improving this. It works one time but next time it freezes. However, if I delete imported tables physically, it works again. So looks like I did not get it right in the first part dealing with deletion of temp tables.


Sub Monthlyroutine()
Dim dbs As Database, tdf As TableDef
Set dbs = CurrentDb

On Error GoTo Macro1_Err

DoCmd.SetWarnings False

'If tables exist, delete it.
For Each tdf In dbs.TableDefs
If tdf.Name = "tblDept1" Or tdfName = "Sale_Cust Data1" Or tdfName = "Region & Areas1" Then
dbs.TableDefs.Delete tdf.Name
End If
Next tdf

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "tblDept1", "Nnorsogfas031Design99 AK FilesZirconDownloadsDepartmental Sale.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Sale_Cust Data1", "Nnorsogfas031Design99 AK FilesZirconDownloadsSales_Cust Data.xls", True
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel3, "Region & Areas1", "Nnorsogfas031Design99 AK FilesZirconDownloadsRegion & Areas.xls", True

' RunSQL executes a SQL string
DoCmd.RunSQL "DELETE FROM tblDepts;"
DoCmd.RunSQL "DELETE FROM [Region & Areas];"
DoCmd.RunSQL "DELETE FROM [Sale_Cust Data];"

dbs.Execute " INSERT INTO tblDepts SELECT * FROM [tblDept1];"
dbs.Execute " INSERT INTO [Sale_Cust Data] SELECT * FROM [Sale_Cust Data1];"
dbs.Execute " INSERT INTO [Region & Areas] SELECT * FROM [Region & Areas1];"

DoCmd.SetWarnings True
Set dbs = Nothing

MsgBox ("All Data updated")

Macro1_Exit:
Exit Sub

Macro1_Err:
MsgBox Error$
Resume Macro1_Exit

End Sub

I'm somewhat familiar with Excel VBA but now have a need to use VBA to import some pipe delimited text files into existing Access tables. These tables were previously created by manually importing these text files. This process has become time consuming so we need to automate it. Some of the tables need to be appended and some need to be cleared and refreshed. Are there any good examples of code that I can use as a starting point for this project? Thanks for any help you can give.

Hi,

I am a novice in access. I would like to

a.)import data from an excel worksheet which the file named is not fixed but the file directory is.(c:import)

b.) After importing the file to a temp table named "Sheet 1". I want to append into the main Table " Table MAIN" and then I will want to delete all records in "Sheet 1" to prepare the table for the next importing process....

Thanks in advance...

This code works perfectly to append one excel file but I need help to amend it so it can append one file after another. Any ideas?

Quote: Option Compare Database
Option Explicit

Const constColumns = 53
Const constFirstLine = 17

' Tracker Fields
Const constRef = 1
Const constDate_of_Reg = constRef + 1
Const constCompany = constRef + 2
Const constContractor = constRef + 3
Const constDirectorate = constRef + 4
Const constProgram_Project = constRef + 5
Const constContract_Descr = constRef + 6
Const constSupply_Service_or_Works = constRef + 7
Const constForm_of_Contract = constRef + 8
Const constTotal_Value = constForm_of_Contract + 1
Const constContract_and_variation_no = constForm_of_Contract + 3
Const constAgreed_Award_Date = constTotal_Value + 4
Const constPeriod_of_Award_Date = constTotal_Value + 5
Const constCustomer_GM = constAgreed_Award_Date + 5
Const constCustomer_BM = constCustomer_GM + 1
Const constGM_Area = constCustomer_BM + 1
Const constGM = constCustomer_BM + 3
Const constBM = constCustomer_BM + 4
Const constProc_Contact = constCustomer_BM + 5
Const constLegal_Contact = constCustomer_BM + 6
Const constCurrent_Status = constLegal_Contact + 1
Const constReason_Code = constLegal_Contact + 3
Const constNext_Management_Steps = constLegal_Contact + 4
Const constActual_Contract_date = constNext_Management_Steps + 11
Const constPeriod_Contract_date = constNext_Management_Steps + 12
Const constStatus = constNext_Management_Steps + 14

Dim appExcel As Excel.Application
Dim xlBook As Object
Dim xlSheet As Object

Dim db As Database
Dim rs As Recordset

Public Sub basControl_Import()

' controlling subroutine for import Excel information
If basOpenRecordset() Then
If basOpenExcel _
("Z: ProcurementPerformanceContracts.xls") _
Then
End If
End If

End Sub

Public Function basOpenRecordset() As Boolean

On Error GoTo basOpenRecordset_err

' Empty the table used to hold the imported information
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tblLive_Tracker"
DoCmd.SetWarnings True

' open the table in preperation of importing the data
Set db = DBEngine(0)(0)
Set rs = db.OpenRecordset("tblLive_Tracker", DB_OPEN_DYNASET)

basOpenRecordset_ok:
On Error Resume Next
basOpenRecordset = True
Exit Function

basOpenRecordset_err:
MsgBox "Error clearing and then opening tblLive Tracker : " & Error(Err)
basOpenRecordset = False
Resume basOpenRecordset_ok


End Function

Public Function basOpenExcel(strFile As String) As Boolean


Dim intI As Integer
Dim intJ As Integer

'Debug.Print "Start: " & Now()
' open Excel as an object
On Error GoTo basOpenExcel_err
Set appExcel = CreateObject("Excel.Application")

' Open the workbook
Set xlBook = appExcel.Workbooks.Open(strFile)
'Open the first worksheet
Set xlSheet = xlBook.Sheets("TRACKER")

' Set the start point
intI = constFirstLine

' Keep reading lines until the first cell on a line contains an empty string
While Len(xlSheet.Cells(intI, 1)) 0
'Debug.Print intI
' Check to see if this line is a recognised data line
If basDataline(intI) Then
' Pull in the fields and add to the recordset
basAddLine (intI)
End If
' Next row
intI = intI + 1
Wend

basOpenExcel = True

basOpenExcel_ok:
' Exit routine
On Error Resume Next
' Close the workbook (no changes to save)
xlBook.Close SaveChanges:=False
' Quit Excel
appExcel.Quit
'Debug.Print "Stop: " & Now()
Exit Function

basOpenExcel_err:
' Error handling
MsgBox "Error opening Excel workbook " & strFile & " worksheet Master Tracker : " & Error(Err)
basOpenExcel = False
Resume basOpenExcel_ok


End Function

Public Function basDataline(intRow As Integer) As Boolean

' Specific test to see if this row has data that we want to import
If xlSheet.Cells(intRow, 1) "Overall Result" Then
basDataline = True
Else
basDataline = False
End If

End Function

Public Sub basAddLine(intLine As Integer)
'Dim tmpDate_12Months As Date
'Dim tmpDate_09Months As Date

DoCmd.SetWarnings True
On Error GoTo basAddline_err

' Create a row in the recordset
rs.AddNew
' Update the fields with the specific data, each field is a specific type)
rs![Ref] = basGetTextField(intLine, constRef)
rs![Date_of_Reg] = basGetDateField(intLine, constDate_of_Reg)
rs![Contractor] = basGetTextField(intLine, constContractor)
rs![Company] = basGetTextField(intLine, constCompany)
rs![Directorate] = basGetTextField(intLine, constDirectorate)
rs![Program_Project] = basGetTextField(intLine, constProgram_Project)
rs![Contract_Descr] = basGetTextField(intLine, constContract_Descr)
rs![Supply_Service_or_Works] = basGetTextField(intLine, constSupply_Service_or_Works)
rs![Form_of_Contract] = basGetTextField(intLine, constForm_of_Contract)
rs![Total_Value] = basGetNumericField(intLine, constTotal_Value)
rs![Agreed_Award_Date] = basGetDateField(intLine, constAgreed_Award_Date)
rs![Period_of_Agreed_date] = basGetTextField(intLine, constPeriod_of_Award_Date)
rs![Customer_GM] = basGetTextField(intLine, constCustomer_GM)
rs![Customer_BM] = basGetTextField(intLine, constCustomer_BM)
rs![Proc_GM] = basGetTextField(intLine, constGM)
rs![Proc_BM] = basGetTextField(intLine, constBM)
rs![Proc_Contact] = basGetTextField(intLine, constProc_Contact)
rs![Legal_Contact] = basGetTextField(intLine, constLegal_Contact)
rs![Current_Status] = basGetTextField(intLine, constCurrent_Status)
rs![Reason_Code] = basGetTextField(intLine, constReason_Code)
rs![Next_Managment_Steps] = basGetTextField(intLine, constNext_Management_Steps)
rs![Actual_Contract_date] = basGetDateField(intLine, constActual_Contract_date)
rs![Period_contract_date] = basGetTextField(intLine, constPeriod_Contract_date)
rs![Status] = basGetTextField(intLine, constStatus)
rs![Contract_and_variation_no] = basGetTextField(intLine, constContract_and_variation_no)
rs![Proc_Area] = basGetTextField(intLine, constGM_Area)


'tmpDate_12Months = DateAdd("m", -12, Date)
'tmpDate_09Months = DateAdd("m", -9, Date)
'rs![agencyLengthOfService] = IIf(rs![agencyDES] < tmpDate_12Months, 12, IIf(rs!agencyDES < tmpDate_09Months, 9, 0))

rs.Update

DoCmd.SetWarnings False

basAddLine_ok:
Exit Sub

basAddline_err:
MsgBox "Error appending line to tblLive Tracker line [" & intLine & "] : " & Error(Err)
Resume basAddLine_ok

End Sub


Public Function basGetTextField(intLine, intCol) As String

' Text field
On Error GoTo basGetTextField_err

basGetTextField = xlSheet.Cells(intLine, intCol)

basGetTextField_ok:
On Error Resume Next
Exit Function

basGetTextField_err:

MsgBox "Error importing text from row " & intLine & " column " & intCol & " " & xlSheet.Cells(intLine, intCol)
basGetTextField = ""
Resume basGetTextField_ok

End Function

Public Function basGetNumericField(intLine, intCol) As Long

' Numeric field
On Error GoTo basGetNumericField_err

basGetNumericField = xlSheet.Cells(intLine, intCol)

basGetNumericField_ok:
On Error Resume Next
Exit Function

basGetNumericField_err:
MsgBox "Error importing numeric from row " & intLine & " column " & intCol & " " & xlSheet.Cells(intLine, intCol)
basGetNumericField = 0
Resume basGetNumericField_ok

End Function

Public Function basGetDateField(intLine, intCol) As Date
' Date field
On Error GoTo basGetdateField_err

basGetDateField = xlSheet.Cells(intLine, intCol)

basGetdateField_ok:
On Error Resume Next
Exit Function

basGetdateField_err:
'MsgBox "Error importing date from row " & intLine & " column " & intCol & " " & xlSheet.Cells(intLine, intCol)
basGetDateField = #1/1/1900#
Resume basGetdateField_ok

End Function

Where do i specify the TAB name ?


	Code:
	pathbgc = Path & "ASIA - OMG Metrics " & CurrentDateText & " " & Month_Name_Long & " " & CurrentYear & ".xls"
DoCmd.TransferSpreadsheet acImport, , "Accuracy-Asia-Flow", pathbgc, vbYes



I have a database which allows users to import data from an excel file that is located in /forms/user.xls off the root of the database. There is a button to open the spreadsheet to edit it and a button to import the data from the spreadsheet. The problem is that the spreadsheet retains the information and if the import button is clicked a second time the information is improted twice. None of the fields on the spreadsheet correspond to the primary key in the table, so it is possible to wind up with duplicates. Is there some VBA I could add to the button's on click event after the import code that would wipe out all the rows but the top one on the spreadsheet or replace the spreadsheet with a blank one from somewhere else?? Thanks

Hi,

I'm a VBA novice and am really struggling with this....


Anyway. This is what i am trying to achieve. I've managed the first three steps in Excel, but have just found out Access has no macro recorder so i'm now completely stumped. The whole process should be:


Allow the user to browse to a .txt file.
That .txt file is opened in excel -
Excel runs text to columns to sort the data.
Access then imports the data as a table
As this will be run more than once, the previous table must be deleted or completed overwritten during the process.

Seperately i can then create an update and an append query to update the database.

Please help! Thanks in advance for your time.

In excel the code to open the text file and sort it to columns is:


	Code:
	 
Sub ImportTextFile()
On Error GoTo ErrTrap
Application.ScreenUpdating = False
 
 
' Below allows user to open a txt file.
 
Dim TxtFileName As String
TxtFileName = GetTextFile("C:Users7092Desktop")
Workbooks.OpenText Filename:=TxtFileName, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote,
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo:=Array(Array(1, 1), Array(2, 1)), DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:=True
If Len(TxtFileName) Then
    If Right$(TxtFileName, 4)  ".txt" Then
        MsgBox "You must select a text file!"
        Exit Sub
    End If
Else
    Exit Sub
End If
 
'below sorts data from the .txt file into columns
 
Sheets("sqlexec").Select
    ActiveSheet.Columns("A:A").Select
    Selection.Texttocolumns Destination:=Range("A:A"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 2), Array(7, 1), Array(9, 1), Array(37, 1), Array(65, 1), _
        Array(75, 1), Array(78, 1), Array(81, 1), Array(84, 1), Array(124, 1), Array(164, 1), Array _
        (204, 1), Array(234, 1), Array(244, 1), Array(260, 1), Array(269, 1)), _
        TrailingMinusNumbers:=True
    Cells.Select
    Cells.EntireColumn.AutoFit
    Columns("N:N").Select
    Selection.NumberFormat = "@"
    Columns("P:P").Select
    Selection.Texttocolumns Destination:=Range("P1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1)), Trailing
 
 
'function to retrieve file
Function GetTextFile(sPath) As String
    ChDir sPath
    GetTextFile = Application.GetOpenFilename( _
        FileFilter:="Text Files (*.txt), *.txt,", _
        FilterIndex:=1, _
        Title:="Select A Text File")
End Function



Hi all,

I've got a line of code that opens an excel file to import it into an access table:


	Code:
	 
DoCmd.TransferSpreadsheet acImport, , "tbl_temp_sql_data", _
 "C:Users7092DocumentsMasterCurrent WorkDB Folderssqlexec.xls", False

As you can see, the file path is hardcoded. Any idea how i could invite the user to select the file rather than hard coding it?

Soz, i'm completely new to VBA but thanks for taking a look!

J

Hi all,

I have an excel template that a lot of people has been using. I need it to be compiled in Access database to keep all the record from everyone into just one database.

So, I would prefer to set an Access database with a Form that has a Browse button that will ask the user to select the filled excel template, then Access will choose the data in the file and append the record in the excel file into the existing tables in the database.

But the excel files has a few notes at top, so the real record starts at row 5. Is it doable? I have a basic to intermediate VBA knowledge. So, VBA coding should be fine to me.

Thanks in advance.

Hi,

Right now I am setting up a database to import 'random' Excel files, placed in a certain folder.

These files are set up as follows:
customer can fill in a certain table (unlocked cells in a locked sheet/workbook). second (invisible) sheet copies values from customer sheet, from row 1 to 228, so I have a neat table to import Access will read the file, import the invisible sheet, job well done. There is only one problem: Access imports all 228 rows, where I only want the filled-in rows.
So, I made a counter, counting all empty cells and subtracting that from 228.
This gives me a value for "filled-in lines".
This value I want to store into a variable, so I can import cells (A1:E)
Now, how do I read a certain cell into a VBA variable?

Currently used code to import (working):


	Code:
	    For intFile = 1 To UBound(strFileList)
        DoCmd.TransferSpreadsheet acImport, , _
        "DealerLists", strPath & strFileList(intFile), True, "parts!A1:E229"
    Next

If my counter value is located in sheet("counters"), field(A2), how do I replace the (!A1:E229) by (A1:E)?

Complete formula:

	Code:
	Sub Link_To_Excel()
     'WillR - www.willr.info (December 2004)
     'Macro Loops through the specified directory (strPath)
     'and links ALL Excel files as linked tables in the Access
     'Database.
     
    Const strPath As String = "xxfilelocation" 'Directory Path
    Dim strFile As String 'Filename
    Dim strFileList() As String 'File Array
    Dim intFile As Integer 'File Number
     
     'Loop through the folder & build file list
    strFile = Dir(strPath & "*.xlsx")
    While strFile  ""
         'add files to the list
        intFile = intFile + 1
        ReDim Preserve strFileList(1 To intFile)
        strFileList(intFile) = strFile
        strFile = Dir()
    Wend
     'see if any files were found
    If intFile = 0 Then
        MsgBox "No files found"
        Exit Sub
    End If
     
     'cycle through the list of files & import to Access
     'appending to tables called DealerLists and DealerContacts
    For intFile = 1 To UBound(strFileList)
        "DealerLists", strPath & strFileList(intFile), True, "parts!A1:E229"
        DoCmd.TransferSpreadsheet acImport, , _
        "DealerContacts", strPath & strFileList(intFile), True, "contact!A1:F2"
    Next
    MsgBox UBound(strFileList) & " Files were Imported"
End Sub

Thanks in advance for your help!
Timoo

Hi all,

I am currently trying to create an automated process to import data from several Excel files into Access daily, which I have managed to get working, however due to the ever increasing size of the excel files I need to delete the imported data from Excel after. I have managed to find a way of deleting the entire Excel file but I don't want to do that, just the data!

The code I have so far works to import the data:

Sub ImportCreditorData()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
Dim strRangeName As String
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:Documents with the real path to the folder that
' contains the EXCEL files
strPath = "G:CreditorIndividual Performance"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "tblCreditorTimesheets"
strRangeName = "TimesheetDataExport"
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames, strRangeName
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
Can anyone help me with the rest?

Many anticipatory thanks

Sazzle

I have the following VBA codes which is working but I wonder how it could be made shorter and more efficient. I have Access 2010 and Excel 2007
I have a table called TempBudget in my Access database made up from the previous year incomes and expenses by month. I want to transfer this table(106 rows and 16 columns) to Excel as it is easier to manipulate spreadsheet in Excel. When I am satisfied with the budget, I want to transfer the table(spreadsheet) back to Access. I want to do everything thru VBA coding.
I tried to transfer the table to Excel with the DoCmd.Output and Docmd.TransferSpreadsheet but both don't transfer table with the xlsm format. I needed a way to get to an Excel file which included macro. Here is the code:
On Error Resume Next
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "TempBudget", "C:DataFinancialProgramTempBudget"
Call BudgetToExcel(BudgetYear)
Sub BudgetToExcel(BudgetYear)
' Late Binding (Needs no reference set)
Dim oXL As Object
Dim oExcel As Object
Dim sFullPath As String
Dim sPath As String
' Create a new Excel instance
Set oXL = CreateObject("Excel.Application")
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0

Select Case (BudgetYear)
Case "2012"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2012.xlsm"

Case "2013"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2013.xlsm"

Case "2014"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2014.xlsm"

Case "2015"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2015.xlsm"

Case "2016"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2016.xlsm"

Case "2017"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2017.xlsm"

Case "2018"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2018.xlsm"

Case "2019"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2019.xlsm"

Case "2020"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2020.xlsm"

Case "2021"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2021.xlsm"

Case "2022"
On Error GoTo ErrHandle
sFullPath = CurrentProject.Path & "Budget2022.xlsm"

End Select

' Open it
With oXL
.Visible = True
.Workbooks.Open (sFullPath)

End With
ErrExit:
Set oXL = Nothing
Exit Sub
ErrHandle:
oXL.Visible = False
MsgBox Err.Description
GoTo ErrExit
End Sub

When the budget file for a given year opens in Excel, I have the following code for the file in Excel (Thisworkbook):

Public Sub Workbook_Open()
Dim wb As Workbook
Dim ws As Worksheet
Set ws = ActiveSheet
Application.DisplayAlerts = False
Set wb = Workbooks.Open("C:DataFinancialProgramTempBudge t") ' import table in budgetyearX
wb.Worksheets(1).Cells.Copy
ws.Range("A1:O107").PasteSpecial
wb.Close
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortField s.Add Key:=Range("B2:B107") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort ' sort table by categoryID
.SetRange Range("A1:O107")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("P2").Select
ActiveCell.FormulaR1C1 = "=SUM(RC[-12]:RC[-1])" ' calculate total for each row and column
Range("P2").Select
Selection.Copy
Range("P2:P107").Select
ActiveSheet.Paste
Range("Q8").Select
Range("P19").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-17]C:R[-2]C)"
Range("D21:O107").Select
Range("D107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("E107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("F107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("G107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("H107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("I107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("J107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("K107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("L107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("M107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("N107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("D21:O107").Select
Range("O107").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("R24").Select
Range("P20").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-86]C:R[-1]C)"
Range("P108").Select
Selection.ColumnWidth = 8.432 ' reset some column width
Range("C2").Select
Selection.ColumnWidth = 20
Range("A1").Select
Selection.ColumnWidth = 5
End Sub

To bring the table back to Access to be used in various reports:

Private Sub Command35_Click()
Call Macro1
End Sub
Function Macro1()
On Error GoTo Macro1_Err
DoCmd.TransferSpreadsheet acImport, 10, "Budget2013", "C:DataQuicken ReplacementBudget2013.xlsm", True, ""
Macro1_Exit:
Exit Function
Macro1_Err:
MsgBox Error$
Resume Macro1_Exit
End Function

Experience:
I know a bit about database design & I know the excel model for VBA quite well, but I'm not that proficient at using VBA in Access yet.

Background:
Building a database that we import weekly reports into. If there is a new client in the file being imported it prompts you to either
1. Map it to an existing client, by creating a row in our alias table that maps all possible spellings to the actual client id.
2. Create a new row (actually 2 rows: 1 in the client table & 1 in the alias table).

Process:
I collect, for example, 3 new clients that need to be either associated with an alias or created new. There is a little form that prefils with the client name. Then you can either pick the proper id from a drop down list (#1 above), or hit the create new button (# 2 above).

Problem:
How to get the VBA code to "pause" until we're finished filling in the details in the form. Sure, I'm opening it in dialog mode, but the loop that basically opens the form and then prefills with the value runs continuously without pause. The effect when you are looking at the form is that only the very last value is prefilled.

Is there any way to force the code to stop immediately until the custom form/dialog is exited? And if so, how do I get the proper prefilled value in? Since I have to have the form open to write to one of its fields, don't I?

Thank you very much for your help in this. The two of us that have been working on this have been cursing frequently at our inability to get anywhere with this! Are we on the right track, at least?

Thank you,
Lori

I am trying to open an excel file as a delimited file using VBA code (so I can perform some automated manipulations on the file from Access before importing the data into a table).

The issue I am having is with using the file open parameters (with the exception of Origin, which Access VBA accepts).

The ones in particular I need to use are DataType:=1 (xlDelimited) and Comma:=True.

The error I receive is "Named Argument Not Found."

The code I am using is as follows:

Dim xl As Object

Set xl = CreateObject("Excel.Application")

With xl
.Visible = True
.UserControl = True
.workbooks.Open "", Origin:=2, StartRow:=1, DataType:=1, TextQualifier:=-4142, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1))


If I just open the file normally, it does not open comma delimited, but instead is all inserted into column A.

I am using Access and Excel 2000.

Any help with this would be greatly appreciated.

Thanks,

~Seth Neustein

Hi, There is a lot of code here, so bare with me
I'm currenlty working on a database that imports .TBL files into it, the format of the TBL files is (for example):

Operational mode: Speed/Classify, 12-class unidirectional File: 104.RTC
Area: 00 Site 004 Location: 02 Direction: Southbound
Description: NCLE INNER CITY BYP NORTH
Count interval: 15 min Detector: Tube Vehicle interval: n/a
Counter No: 3008 Firmware version: 2.04
Counter read at: 13:16:51 on 15/06/2004
First count recorded at: 16:00:00 on 11/06/2004
Last count ended at: 13:15:00 on 15/06/2004
Total vehicles recorded: 44696 Total axles recorded: 89429
Detector spacing: 1000mm Channel 1
Site log: ®empty¯
__________________________________________________ ____________________

Date Time Cl Spd Unclass

11/06 16:00 1 63
11/06 16:00 1 64
11/06 16:00 1 60
11/06 16:00 1 59
11/06 16:00 1 56
11/06 16:00 1 54
11/06 16:00 1 61
11/06 16:00 1 63
11/06 16:00 1 61
11/06 16:00 1 54
11/06 16:00 1 56

As u can see, there is a header followed by columns of data. I want to import these columns into a specific table in the database without the header. I may also want to import specific information from the header into a separately table. Now I want to do this automatically using VBA code. I kinda have done a bit of it in excel, but I Want it so I don't have to import the spreadsheet into the access database, rather I want to import the above .TBL file directly. Now I want to do multiple files into the one table as well. and also, everytime I import stuff, I don't want to be importing the same data over and over again.

I started off doing a bit of coding but this is mainly for importing excel spreadsheets:

Function ImportSpreadsheet(tblname, filenm, rge)
DoCmd.TransferSpreadsheet transfertype:=acImport, _
spreadsheettype:=acSpreadsheetTypeExcel7, _
tablename:=tblname, _
filename:=filenm, _
hasfieldnames:=True, _
range:=rge
End Function

Function ImportTxtFile(tblname, filenm)
DoCmd.TransferText acExportDelim, _
specificationname:="Steves Spec name", _
tablename:=tblname, _
filename:=filenm, _
hasfieldnames:=True
End Function

Function OpenFile()
'Declaration of a variable as a FileDialog object.
Dim fd As FileDialog
'Creates a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declares a variable to contain the path
'of each selected item.
Dim vrtSelectedItem As Variant
'references the FileDialog object.
With fd
'displays the File Picker dialog box
If .Show = -1 Then
'Step through the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
If vrtSelectedItem = "C:Documents and SettingsSteveDesktopcounterDBtestSpeed.xls" Then
speedsheet = ImportSpreadsheet("tblSpeedTest", vrtSelectedItem, "A:Z")
Else: vrtSelectedItem = "C:Documents and SettingsSteveDesktopcounterDBtempClassRTC.XLS"
classsheet = ImportSpreadsheet("tblClassTest", vrtSelectedItem, "A:Z")
End If
'If vrtSelectedItem Then
'blahtxt = ImportTxtFile("tblSpeedTest", vrtSelectedItem)
'Else: vrtSelectedItem
'blahtxt2 = ImportTxtFile("tblClassTest", vrtSelectedItem)
'End If
Next vrtSelectedItem
'The user pressed Cancel.
Else
'inp = InputBox("Would you like to import a text file or a spreadsheet?", "What would you like to do?")
'If inp = "text" Then
'MsgBox ("You have selected to import a text file")
'Else
'MsgBox ("You have selected to import a spreadsheet file")
'End If
MsgBox ("For future reference, it is preferable that you only select appropriate EXCEL and TBL files.")
End If
End With

'Sets the object variable to Nothing.
Set fd = Nothing

End Function

I will paste the code I used to import stuff in excel, in the next posts


Thanks guys, any help would be appreciated

Hello,

The scenario:

I am using Access 97 and VBA. I have a form that is used to import excel files into access tables. The user sees a sample of the sheets and cells on the excel file so they choose which column contains which field. This is because the excel files could be sent to us with the required data in any of the columns.

There is also a button that will allow the user to view the excel file and because they can then close the file I handle the beforeclose of the workbook using with events and cancel that event.

I declare the app and workbook as

Public v_excel_app As New Excel.Application
Public WithEvents v_workbook As Excel.Workbook

I set it on loading of the form with

Set v_workbook = v_excel_app.Workbooks.Open(v_file_name)

The v_excel_app remains hidden, I only set visible to true when the user clicks the 'view' button.

I close the workbook and quit v_excel_app at a later stage in the code.


My Problem:

This all works perfectly fine except when the same excel file is open from Windows Explorer. If the excel app is hidden it doesn't appear to have done anything however this seems to confuse the v_workbook object and I get the following error message only when I try to do something with the object like loop through all the sheets or close it (with code).

Run-time error '-2147417848 (80010108)':

Automation error
The object invoked has disconnected from its clients.


Any help or advice on how to either reconnect the workbook or stop the user opening the file via windows explorer would be welcome, I have been searching on the net for while but to no avail.

Thank you
Mark

Hello,

I need to import multiple excel files located in a specific folder. I am able to import one and then delete it from the location (see code below) but I want to be able to do the same thing for all the excel files in that folder.

I am a VBA beginner and have search all over this forum and online but no luck. I want to learn so you help would be appreciated!

Thanks!!!


Private Sub Command1_Click()

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "updates_temp_tbl", "c:temp_importslatest_updates_karen.xls", True

Kill "c:temp_importslatest_updates_karen.xls"

End Sub

Hi Experts,

I am writting a module program using VBA in Access, and I have serious difficulties.
Objectives of the program:
-To do many queries from a database
- Export those queries in excel format. Some queries must be grouped in one files(i.e. putting the queries in different sheets of the same excel file)
- exporting those files using a template. It think this mite not be possible, but i was thinking in just making the template on the code... the template is only having a header and a footer.

So far:
What I have been able to do so far is to create queries directly and exporting them in to single excel files.
Also, I could run queries using recordset, but then don't know how to handle the data of the recordset (i.e. don't know how to get data out of the recordset and put it in a spreadsheet)

and one of the most important points, I am able to write in a excel file, in the first sheet, but dunno how to write on the second sheet and so on.

Just wondering if anyone can help me with any of my task. PLEASE...YOUR HELP IS MUCH APPREACIATTED .... THANKS IN ADVANCE

My first post.. I am not a native english-speaker, so hopefully I can make myself clear.

I have the following problem
I have a excel-file that will be used to update information in a easy way, so outside Access.
It is a kind of a crosstab-format:

Product - Client1 - Client2 - Client3 - ... - ... - Client18 (variable information)
product1 - 100 - 105 - 95
product2 - 200 - 210 - 190
...
...
product180 - 300 - 305 - 295

I want to import this in a easy way to Access (access2000, if someone wants to know)
In access I want the information in a other format:
product - Client - Price

product1 - client1 - 100
product1 - client2 - 105
product1 - client3 - 95
product2 - client1 - 200
product2 - client2 - 210
etc

Now I already have a solution for this, a SQL-query.
First I import the data from excel to a tmptable in access.
Second I run the SQL-query (SELECT, UNION ALL SELECT kind of query)

Only this is not what I want. It's not flexible enough and it isn't easy to use.
I created my tmptable and my SQLcode for 16 clients. When I need to import 18 clients, I first need to change my table and my SQL-query. And I only want to create the dbase, someone else will work with it.

I think it would be easier when a script automatically reads the values of Row1 (so 'Client1', 'Client2', 'Client3', etc). Automatically reads column A (all products). And of course the values as values.
And then prints the results in the correct table in Access.

I think this can be done with some VBA-code.
But how to do it...
My knowledge of VBA is growing, but isn't that great I can do this myself...
So it would be great if anybody can help me!

So i have an rtf file with some tables within it. There is also extraneous data. This file is generated from an application written by Quilogy and I have the task of taking this file and putting it through access to create a payroll file. There will generally be 3 to 4 lines of heading information, a couple blank lines, then a large table, with all this being repeated 3 to 8 times in a file.

My thought to get it into access tables works, but only by hand. I've run into considerable problems coding it. So here goes...

The process i figured out to get it from rtf to access is to:
1) open the rtf in word
2) copy all
3) open excel
4) paste with cursor at cell A1
This pastes the data in the table format
5) save the excel file
6) import the excel spreadsheet as a table into access
7) use delete and update queries to remove the extraneous lines and filter down to true data

So, I've gotten my vba code to open word, open the appropriate rtf file, copy all, then i'm stuck. I can't get excel to open and paste. here is the snippet I'm attempting to use:


	Code:
	    Dim ExcApp As Excel.Application 
    Dim ExcBook As Excel.Workbook 
    Set ExcApp = New Excel.Application 
    With ExcApp 
        .Visible = True 
        Set ExcBook = ExcApp.Workbooks.Add
    ExcApp.ActiveSheet.Paste

I can get the save part after that i think, but this part won't work. i generally get the "workbook paste method failed" error, though the errors have changed from time to time.

basically what i'm after is either how to make this paste into the sheet so i can let the clipboard reformat or how to get the rtf file into access some other way. i tried saving it as text, and was successful, but when i open it all the table fields each start a new line and i can't get it not to.


Not finding an answer? Try a Google search.