Automated Import on multiple Files

[thickey]

Hi I have some code already that takes a list of file names and imports the data from Excel to Access using range names. The code is below.. The code looks at the filenames and transfers data into tables then inserts the names into various tables using SQL insert. What I would like is for the user to be able to click on a button within a form and be able to multiselect a list of files no matter where they are situated. I already have some code to do this but I need to split out the file names and directorys individually.

Function Command5_Click()
'Private Sub mcrImportInpatientClaims(Command5_Click)
On Error GoTo mcrImportInpatientClaims_Err
Dim ImmFileName As String
Dim ImmFoldName As String
Dim a, b As Long
Dim FoldArray(120) As String
a = 0
b = 0

'set up array for portion of filename
FoldArray(0) = "Avionics"
FoldArray(1) = "Batteries"
FoldArray(2) = "Vehicles"
FoldArray(3) = "Travel"
FoldArray(4) = "CSM"
FoldArray(5) = "DGST&F"
FoldArray(6) = "DGS-P&C"
FoldArray(7) = "DGS-PPM"
FoldArray(8) = "Fixed_Wing"
FoldArray(9) = "Gas Turbines"
FoldArray(10) = "ISA"
FoldArray(11) = "IS-IT"
FoldArray(12) = "NBP"
FoldArray(13) = "Rotary_Wing"
FoldArray(14) = "SBO(AIR)"
FoldArray(15) = "SBO(DCIPT)"
FoldArray(16) = "SBO(LAND)"
FoldArray(17) = "SBO(SEA)"
FoldArray(18) = "Transport"
FoldArray(19) = "Upkeep_Surface_Vessels"


DoCmd.OpenQuery "Delete_YCosolidation", acNormal, acEdit
DoCmd.OpenQuery "Data_Assisted", acNormal, acEdit
DoCmd.OpenQuery "Data_Direct", acNormal, acEdit


'start the process
For a = LBound(FoldArray) To UBound(FoldArray)
'hardcode the part of filename that is the same.

ImmFileName = CStr(FoldArray(a)) & ".xls"
'Replace "PUT DIRECTORY HERE" with the folder where the files are stored
ImmFoldName = "D:\Documents and Settings\uk09898\My Documents\Mark P query\"
'check to see if file and folder exists
If FileExists(ImmFoldName & ImmFileName) Then
'put in parameters for the transfertext.


'Delete Temp Table
DoCmd.DeleteObject acTable, "Cash_Savings_Targets"
DoCmd.DeleteObject acTable, "Forecast_Cash_Spend"
DoCmd.DeleteObject acTable, "Total_Cash_Savings_Identified"
DoCmd.DeleteObject acTable, "Initial_Stage"
DoCmd.DeleteObject acTable, "Under_Investigation"
DoCmd.DeleteObject acTable, "Source_Resource_Plan_Approved"
DoCmd.DeleteObject acTable, "Ipt_Agency_Approved"
DoCmd.DeleteObject acTable, "Contracts_In_Place"
DoCmd.DeleteObject acTable, "Actual_Savings"
DoCmd.DeleteObject acTable, "AssTotal_Cash_Savings_Identified"
DoCmd.DeleteObject acTable, "AssInitial_Stage"
DoCmd.DeleteObject acTable, "AssUnder_Investigation"
DoCmd.DeleteObject acTable, "AssSource_Resource_Plan_Approved"
DoCmd.DeleteObject acTable, "AssIpt_Agency_Approved"
DoCmd.DeleteObject acTable, "AssContracts_In_Place"
DoCmd.DeleteObject acTable, "AssActual_Savings"
DoCmd.DeleteObject acTable, "Assisted_Benefits_Period_End"
DoCmd.DeleteObject acTable, "DLO_Benefits_Period_End"



'Transfer Data To Tables
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Actual_Savings", ImmFoldName & ImmFileName, False, "Actual_Savings"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssActual_Savings", ImmFoldName & ImmFileName, False, "AssActual_Savings"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssContracts_In_Place", ImmFoldName & ImmFileName, False, "AssContracts_In_Place"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssInitial_Stage", ImmFoldName & ImmFileName, False, "AssInitial_Stage"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssIpt_Agency_Approved", ImmFoldName & ImmFileName, False, "AssIpt_Agency_Approved"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssSource_Resource_Plan_Approved", ImmFoldName & ImmFileName, False, "AssSource_Resource_Plan_Approved"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssTotal_Cash_Savings_Identified", ImmFoldName & ImmFileName, False, "AssTotal_Cash_Savings_Identified"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "AssUnder_Investigation", ImmFoldName & ImmFileName, False, "AssUnder_Investigation"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Cash_Savings_Targets", ImmFoldName & ImmFileName, False, "Cash_Savings_Targets"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Contracts_In_Place", ImmFoldName & ImmFileName, False, "Contracts_In_Place"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Forecast_Cash_Spend", ImmFoldName & ImmFileName, False, "Forecast_Cash_Spend"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Initial_Stage", ImmFoldName & ImmFileName, False, "Initial_Stage"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Ipt_Agency_Approved", ImmFoldName & ImmFileName, False, "Ipt_Agency_Approved"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Source_Resource_Plan_Approved", ImmFoldName & ImmFileName, False, "Source_Resource_Plan_Approved"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Total_Cash_Savings_Identified", ImmFoldName & ImmFileName, False, "Total_Cash_Savings_Identified"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Under_Investigation", ImmFoldName & ImmFileName, False, "Under_Investigation"

DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "Assisted_Benefits_Period_End", ImmFoldName & ImmFileName, False, "Assisted_Benefits_Period_End"
DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel97, "DLO_Benefits_Period_End", ImmFoldName & ImmFileName, False, "DLO_Benefits_Period_End"


' Updates Field Rows With Area Information
DoCmd.RunMacro "xUpdate_Row_Names", , ""
' Updates and Consolidates Data Into One Table


' Update Field Rows With FileName Information
DoCmd.RunSQL "INSERT INTO YCosolidation ( Track, F1, F2, F3, F4, F5, F6, F7, F8, F9 ) SELECT ('" & CStr(FoldArray(a)) & "') AS Track, [Union Query].F1, [Union Query].F2, [Union Query].F3, [Union Query].F4, [Union Query].F5, [Union Query].F6, [Union Query].F7, [Union Query].F8, [Union Query].F9 FROM [Union Query];"


' Update Field Rows With End Of Period Information
DoCmd.RunSQL "INSERT INTO [Data Direct] ( Track, Field1, Field2 ) SELECT ('" & CStr(FoldArray(a)) & "') AS Track, [DLO_Benefits_Period_End].F1, [DLO_Benefits_Period_End].F2 FROM [DLO_Benefits_Period_End];"
DoCmd.RunSQL "INSERT INTO [Data Assisted] ( Track, Field1, Field2 ) SELECT ('" & CStr(FoldArray(a)) & "') AS Track, [Assisted_Benefits_Period_End].F1, [Assisted_Benefits_Period_End].F2 FROM [Assisted_Benefits_Period_End];"






End If
'This part is not needed if you are only looking at one type of file name.
ImmFileName = CStr(FoldArray(a)) & "Phar_356" & ".Txt"
If FileExists(ImmFoldName & ImmFileName) Then
DoCmd.TransferText acImportFixed, "Pharm2 Encounters Import Specification", "Pharm04", ImmFoldName & ImmFileName, False, ""
End If
ImmFileName = CStr(FoldArray(a)) & "Prof_356" & ".Txt"
If FileExists(ImmFoldName & ImmFileName) Then
DoCmd.TransferText acImportFixed, "Prof(1500) Encounters Import Specification", "Prof04", ImmFoldName & ImmFileName, False, ""
End If
Next a

mcrImportInpatientClaims_Exit:
Exit Function

mcrImportInpatientClaims_Err:
MsgBox Error$
Resume mcrImportInpatientClaims_Exit

End Function

 

[Blorf]

I did not examine your code in detail, but I have a question.

What do you need help with? Allowing the user to select files? What method are you currently using to select them?

Are you looking for the windows file select dialouge?

ChaZ

 

[thickey]

Hi, I am working in access 97 and am wanting to use a file select dialouge box with the ability to mutiselect files from any directory. I need to understand how to break the File String up. E.G The code runs a loop I need it to insert the last directory within a string and the filename without the file extention and the entire directory string into seperate items for the loop. Any guidance on this would be great..

Cheers