tnguyen315
MIS
Hello, please help me with the code below. These codes used to work with the old MS access but access 2007 got an error on "FileSearch". Thanks.
Public Sub ImportMultipleTextFiles()
On Error GoTo Err_subImport
Dim stDocName As String
Dim fs As Dictionary
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim y As Integer
Dim ShortFn As String
specname = "Monitor Download"
DoCmd.SetWarnings False
sql = "DELETE FROM Reportdl2"
DoCmd.RunSQL sql 'Empty Temp Table
DoCmd.SetWarnings False
oktogo = False
ifn = CurrentProject.Path & "\Imports\"
Set fs = Application.FileSearch
With fs
.LookIn = ifn
.FileName = "Reportdl2.txt"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
ShortFn = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
DoCmd.TransferText acImportDelim, specname, "Reportdls", .FoundFiles(i), True
subArchive .FoundFiles(i)
y = y + 1
Next i
Else
MsgBox "Please ensure that the source file is present and try again" & vbCr _
& "Required file location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"
Exit Sub
End If
End With
MsgBox "Import completed. " & y & " files Imported", vbOKOnly + vbInformation, "Import Completed."
Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True
Exit Sub
Err_subImport:
MsgBox Err.Description
Resume Exit_subImport
End Sub
And also, after "import completed", I would like to delete the sub-folder which contain those text files.
For instance:
...\Imports\912540\Reportdl2.txt
...\Imports\154828\Reportdl2.txt
...\Imports\845522\Reportdl2.txt
I would like to delete those folders: 912540, 154828, 845522.
Please help, thanks.
I'm very appreciated.
Public Sub ImportMultipleTextFiles()
On Error GoTo Err_subImport
Dim stDocName As String
Dim fs As Dictionary
Dim ifn As String
Dim sql As String
Dim today As String
Dim fso As Scripting.FileSystemObject
Dim oktogo As Boolean
Dim specname As String
Dim repdate As String
Dim myfile As Scripting.TextStream
Dim i As Long
Dim y As Integer
Dim ShortFn As String
specname = "Monitor Download"
DoCmd.SetWarnings False
sql = "DELETE FROM Reportdl2"
DoCmd.RunSQL sql 'Empty Temp Table
DoCmd.SetWarnings False
oktogo = False
ifn = CurrentProject.Path & "\Imports\"
Set fs = Application.FileSearch
With fs
.LookIn = ifn
.FileName = "Reportdl2.txt"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
ShortFn = Right(.FoundFiles(i), Len(.FoundFiles(i)) - InStrRev(.FoundFiles(i), "\"))
DoCmd.TransferText acImportDelim, specname, "Reportdls", .FoundFiles(i), True
subArchive .FoundFiles(i)
y = y + 1
Next i
Else
MsgBox "Please ensure that the source file is present and try again" & vbCr _
& "Required file location: " & vbCr & ifn, vbExclamation + vbOKOnly, "Input File Missing"
Exit Sub
End If
End With
MsgBox "Import completed. " & y & " files Imported", vbOKOnly + vbInformation, "Import Completed."
Exit_subImport:
' Turn warning messages back on
DoCmd.SetWarnings True
Exit Sub
Err_subImport:
MsgBox Err.Description
Resume Exit_subImport
End Sub
And also, after "import completed", I would like to delete the sub-folder which contain those text files.
For instance:
...\Imports\912540\Reportdl2.txt
...\Imports\154828\Reportdl2.txt
...\Imports\845522\Reportdl2.txt
I would like to delete those folders: 912540, 154828, 845522.
Please help, thanks.
I'm very appreciated.