Add Filename Column for Multiple Excel Import

[beirrac]

Hello,

I currently import 50 - 80 excel files to access using the code shown below. Unfortunately, some of the records on the files are missing information. This creates a nightmare when I try to find which excel file has the incorrect or missing information. Is there a way to add the file name to each record when the data is imported from excel? Any assistance would be truly appreciated.

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
blnHasFieldNames = False

strPath = "h:\letters\_ADHOCS to UHGPS\Batch 5 Std Prov Terms\COSMOS MAILINGS\"
strTable = "sheet1"
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
strTable, strPathFile, blnHasFieldNames

strFile = Dir()
Loop

 

[MUKESHY12390]

Here you go..
Add one field to table (strTable) and give name to "FileName".

after this line "DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, strTable, strPathFile, blnHasFieldNames"

add "Update sql query"

[/COLOR]UPDATE sheet1 SET sheet1 .[fileName]=  Is Null
WHERE sheet1 .[fileName] ="strFile"
[COLOR=#333333]

what I assumed here before importing 50-80 excel files into Access , the table would be blank.

 

[beirrac]

what I assumed here before importing 50-80 excel files into Access , the table would be blank.[/COLOR][/QUOTE]

Yes, the table is blank.

Thank you. When I tried adding this and running, I'm getting the error: Compile error: Expected end of statement on SET. Any advise?

 

[MUKESHY12390]

pls post complete code

 

[beirrac]

pls post complete code

Sorry, this is the complete code.

Private Sub Command3_Click()

Dim strPathFile As String, strFile As String, strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
 ' contains the EXCEL files
 strPath = "h:\letters\_ADHOCS to UHGPS\Batch 5 Std Prov Terms\COSMOS MAILINGS\"

' Replace tablename with the real name of the table into which
 ' the data are to be imported
 strTable = "sheet1"

 strFile = Dir(strPath & "*.xls")
 Do While Len(strFile) > 0
       strPathFile = strPath & strFile
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
             strTable, strPathFile, blnHasFieldNames
UPDATE sheet1 SET sheet1. [fileName]=  Is Null
WHERE sheet1 .[fileName] ="strFile"

 Loop

End Sub

 

[MUKESHY12390]

hey try this...

Option Compare Database
Option Explicit




Sub oGetFileName()
'NOTE: To use this code, you must reference
'The Microsoft Office 14.0 (or current version)  And Microsoft Scripting RunTime
''Go To Tool and select these both reference object


Dim oRecon_FileStr        As String
Dim oRecon_fDialog         As Office.FileDialog


Set oRecon_fDialog = Application.FileDialog(msoFileDialogFolderPicker)


  With oRecon_fDialog
    .AllowMultiSelect = True
    .Title = "Please select ONE Folder"
      If .Show = True Then
          oRecon_FileStr = .SelectedItems(1)
        Else
          MsgBox "You clicked Cancel in the file dialog box."
        Exit Sub
      End If
  End With
DoCmd.SetWarnings False
  DoCmd.RunSQL "Delete * from sheet1"   '''' clear table before importing Excel files
DoCmd.SetWarnings True
  
 Call getlist(oRecon_FileStr, True)




End Sub


Function getlist(opath1 As String, fsfolder1 As Boolean)
Dim ofso              As Scripting.FileSystemObject
Dim ofile             As File
Dim ofolder           As Folder
Dim osubfolder        As Folder
Dim i                 As Integer
Dim oRecon_otype      As String
Dim oTableName        As String
Dim ofilepath         As String
Dim oSQLQuery         As String
Dim oExFileName       As String


oRecon_otype = "Excel"
oTableName = "sheet1"    '''''''''''''''''' Access table where to import
On Error GoTo ExitDoor
Set ofso = New Scripting.FileSystemObject
Set ofolder = ofso.GetFolder(opath1)


i = 2




For Each ofile In ofolder.Files
  If VBA.InStr(1, ofile.Name, "~") = 0 Then
    If ofile.Type Like "*" & oRecon_otype & " *" Then
    '
      Debug.Print ofile.Path
      ofilepath = ofile.Path
      oExFileName = ofile.Name
      
              DoCmd.TransferSpreadsheet acImport, , oTableName, ofilepath, True
              
        ''''''''''''''''''''' I was taking about these below three line'''''''''''''''''''''
              DoCmd.SetWarnings False
                DoCmd.RunSQL "UPDATE sheet1 SET sheet1.[fileName] = '" & oExFileName & "' WHERE sheet1.[FileName] Is Null "
              DoCmd.SetWarnings True
        ''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      i = i + 1
     End If
  End If
Next ofile


MsgBox "Completed"


Exit Function


ExitDoor:
MsgBox Err.Number & " - " & Err.Description
End Function

 

[MUKESHY12390]

[QUOTE
'''''wrong syntax
UPDATE sheet1 SET sheet1. [fileName]= Is Null
WHERE sheet1 .[fileName] ="strFile"

[/QUOTE]

'should be like this
''''''''''''''''''''' I was taking about these below three line'''''''''''''''''''''
              DoCmd.SetWarnings False
                DoCmd.RunSQL "UPDATE sheet1 SET sheet1.[fileName] = '" & [COLOR=#333333]strFile [/COLOR]& "' WHERE sheet1.[FileName] Is Null "
              DoCmd.SetWarnings True
        ''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

[beirrac]

THANK YOU! This worked perfectly. All I needed to change was the TransferSpreadsheet to read "False" because "standard record layout" seems to be a foreign language . You have saved me hours of time doing manual look ups or listening to complaints when I tell folks they need to find the files with the bad records. THANK YOU AGAIN! I truly appreciate it.
Carrie

 

[MUKESHY12390]

I'm glad it help you .....thanks for feedback