I have a folder on our company share drive that contains text files ONLY. I want to use this If Statement to exit Sub Procedure if files are other then Text Document. The issue is that objFolder.Type is pointing to the "File Folder".......
'Check if the folder contains only Text Document If objFolder.Type <> "Text Document" Then
MsgBox "Please remove files that are not Text Documents, then try again...", vbExclamation
Exit Sub
Else
Option Compare Database
Option Explicit
Public FSO As New FileSystemObject
Sub MyList()
'Declaring variables
Dim objFolder As Folder
Dim objFile As File
Dim strPath As String
Dim db As Database
Dim sfilename As String
Dim ifilesize As String
Dim SSQL As String
Dim dmoddate As Date
Dim fs, f, retstring
Dim FileType As String
Dim iRecCt As Long
Dim DateLoaded As Date
'Specify the path of the folder
Set fs = CreateObject("scripting.filesystemobject")
strPath = "C:\Documents\Darlene\"
'Create the object of this folder
Set objFolder = fs.GetFolder(strPath)
'Check if the folder is empty or not
If objFolder.Files.Count = 0 Then
MsgBox "No files were found, please load your text files and try again...", vbExclamation
Exit Sub
End If
'Check if the folder contains only Text Document
If objFolder.Type <> "Text Document" Then
MsgBox "Please remove files that are not Text Documents, then try again...", vbExclamation
Exit Sub
Else
Set db = CurrentDb
For Each objFile In objFolder.Files
sfilename = objFile.Name
ifilesize = objFile.Size
dmoddate = objFile.DateLastModified
FileType = objFile.Type
DateLoaded = objFile.DateCreated
Set f = fs.OpenTextFile(strPath & objFile.Name, ForReading, TristateFalse)
iRecCt = 0
Do While f.AtEndOfStream <> True
iRecCt = iRecCt + 1
retstring = f.ReadLine
Loop
f.Close
'New
SSQL = "INSERT INTO tblData (FileName, FileSize, FileModified, FileRecords, FileType, DateLoaded) VALUES ('" & sfilename & "', " & ifilesize & ", #" & dmoddate & "#," & iRecCt & ", '" & FileType & "', #" & DateLoaded & "#)"
'==========================
db.Execute (SSQL), dbFailOnError 'Change to 'DoCmd.RunSQL SSQL
'===============================================
Next objFile
End If
'End If
Error_Handler_Exit:
On Error Resume Next
Set fs = Nothing
Set db = Nothing
MsgBox "Files are loaded to the tables."
Exit Sub
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: MyList" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub