Adding MsgBox to For Each Loop

M

mreference

Registered User.
Local time
Today, 17:14
Joined
Oct 4, 2010
Messages
137
I am using the following code to import records into a table if they meet certain criteria, then once it has been imported, the file is moved to another location. This works extremely well.

Code: 
Private Sub bImportFiles_Click()
On Error GoTo bImportFiles_Click_Err

Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

strFolderPath = "C:\Amazon\MerchantTransport\production\report  s\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files

For Each objF1 In objFiles
If Right(objF1.Name, 3) = "txt" Then
DoCmd.TransferText acImportDelimited, "OrderAmazon", "tblOrdersAmazon", strFolderPath & objF1.Name, False
Name strFolderPath & objF1.Name As  "C:\Amazon\MerchantTransport\production\report  s\" & objF1.Name  'Move the files to the archive folder
End If
Next

Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing

bImportFiles_Click_Exit:
Exit Sub

bImportFiles_Click_Err:
MsgBox Err.Number & " " & Err.Description
Resume bImportFiles_Click_Exit

End Sub
What I would like to include is a message box that prompts the user that no files are currently available to import.

Code: 
MsgBox "There are currently no records to import." & _
            vbCrLf & "Please try again later."
But if I inlucde this as part of an Else If or Else or even a new IF statement, I get this error message
Code: 
Error 91: Object variable or With block variable not set
or the message box keeps popping up a few times as it is presumably stuck in the For Each Loop.

Could somebody point me in the right direction, so that if no files exist I get the pop up message box once.

cheers
 
Is it possible for you to show the final/complete code that gives you the Error 91? Also is this two separate lines of code or is it a typo?
Code: 
            DoCmd.TransferText acImportDelimited, "OrderAmazon", "tblOrdersAmazon", strFolderPath & objF1.Name, False
            Name strFolderPath & objF1.Name As "C:\Amazon\MerchantTransport\production\report    s\" & objF1.Name  'Move the files to the archive folder
 
Nice to hear from you again Paul.

I tried quite a few combinations to get it to work but one of them was trying to input another IF statement, I did try this as well and change the second IF statement to an Else.


Code: 
Private Sub bImportFiles_Click()
On Error GoTo bImportFiles_Click_Err

Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strFolderPath As String

strFolderPath = "\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\"
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strFolderPath)
Set objFiles = objFolder.files

If Left(objF1.Name, 5) <> "ORDER" Then
MsgBox "There are currently no records to import." & _
            vbCrLf & "Please try again later."
End If


For Each objF1 In objFiles
If Right(objF1.Name, 3) = "txt" And Left(objF1.Name, 5) = "ORDER" Then
DoCmd.TransferText acImportDelimited, "AmazonImportSpecification", "tblTempAmazonImports", strFolderPath & objF1.Name, False
Name strFolderPath & objF1.Name As "\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\archived\" & objF1.Name 'Move the files to the archive folder
End If
Next


            
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing


bImportFiles_Click_Exit:
Exit Sub

bImportFiles_Click_Err:
MsgBox Err.Number & " " & Err.Description
Resume bImportFiles_Click_Exit

End Sub
 
Last edited:
The Else in the For should work, provided you let me know what the highlighted bit is.. That does not look right to me..
Code: 
Private Sub bImportFiles_Click()
On Error GoTo bImportFiles_Click_Err
    Dim objFS As Object, objFolder As Object
    Dim objFiles As Object, objF1 As Object
    Dim strFolderPath As String

    strFolderPath = "\\[COLOR=Blue][B]serverLocation[/B][/COLOR]\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(strFolderPath)
    Set objFiles = objFolder.files

    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "txt" And Left(objF1.Name, 5) = "ORDER" Then
           [COLOR=Green] 'Move the files to the archive folder[/COLOR]
            [COLOR=Red][B]DoCmd.TransferText acImportDelimited, "AmazonImportSpecification", "tblTempAmazonImports", strFolderPath & objF1.Name, False
            Name strFolderPath & objF1.Name As "\\[/B][/COLOR][COLOR=Blue][B]serverLocation[/B][/COLOR][COLOR=Red][B]\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\archived\" & objF1.Name [/B][/COLOR]
        Else
            MsgBox "There are currently no records to import." & vbCrLf & "Please try again later."
        End If
    Next

    Set objF1 = Nothing
    Set objFiles = Nothing
    Set objFolder = Nothing
    Set objFS = Nothing

bImportFiles_Click_Exit:
    Exit Sub
bImportFiles_Click_Err:
    MsgBox Err.Number & " " & Err.Description
    Resume bImportFiles_Click_Exit
End Sub
 
Last edited:
Code: 
DoCmd.TransferText acImportDelimited, "AmazonImportSpecification", "tblTempAmazonImports", strFolderPath & objF1.Name, False 'Transfers data to table

Name strFolderPath & objF1.Name As "\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\archived\" & objF1.Name 'Move the files to the archive folder
1st line transfers all the data contained within the text files in the windows directory into a table
2nd line then moves that .txt file from one windows directory to another directory so it is not used again

The text files in the windows folder are created by Amazon software, which imports data from Amazon every hour with order details.
 
I was concerned about the 2nd Line.. Did a little bit of research.. and found Name function.. So I hope it works now?
 
What I have found is that if there are files in the directory other than the ones to be processed (I have 6), the message will pop up 6 times. If I move those files to another folder so no files are present, the pop up doesn't appear.
 
Is that not what you want to do? I mean see if there are any files to process, if so Add that to the table and move the processed file to new location.. else tell the user there is nothing to process..
 
Is that not what you want to do? I mean see if there are any files to process, if so Add that to the table and move the processed file to new location.. else tell the user there is nothing to process..
Click to expand...

That's what I would like, but currently if no files are in the windows folder to be imported, I get no pop up message at all. It's as if the msgbox doesn't exist.
 
How about..
Code: 
Private Sub bImportFiles_Click()
On Error GoTo bImportFiles_Click_Err
    Dim objFS As Object, objFolder As Object
    Dim objFiles As Object, objF1 As Object
    Dim strFolderPath As String

    strFolderPath = "\\serverLocation\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(strFolderPath)
    Set objFiles = objFolder.files

    [COLOR=Blue][B]If Dir(strFolderPath & "*.*") <> "" Then[/B][/COLOR]
        For Each objF1 In objFiles
            If Right(objF1.Name, 3) = "txt" And Left(objF1.Name, 5) = "ORDER" Then
                'Move the files to the archive folder
                DoCmd.TransferText acImportDelimited, "AmazonImportSpecification", "tblTempAmazonImports", strFolderPath & objF1.Name, False
                Name strFolderPath & objF1.Name As "\\serverLocation\Users\Public\Documents\StockDatabase\BackEndTables\Test Stage - Do Not Delete\reports\archived\" & objF1.Name 
            Else
                MsgBox "This file is not the right format - " & objF1.Name
            End If
        Next
   [COLOR=Blue][B] Else
        MsgBox "There are currently no records to import." & vbCrLf & "Please try again later."
    End If[/B][/COLOR]

    Set objF1 = Nothing
    Set objFiles = Nothing
    Set objFolder = Nothing
    Set objFS = Nothing

bImportFiles_Click_Exit:
    Exit Sub
bImportFiles_Click_Err:
    MsgBox Err.Number & " " & Err.Description
    Resume bImportFiles_Click_Exit
End Sub
 
Last edited:
the following error message popped up

Code: 
450 wrong number of arguments or invalid property assignment
 
Glad you have it finally got it working.. :) Good Luck !!
 
You must log in or register to reply here.

Similar threads

P
Solved File Read error
2
Replies
33
Views
1,747
gemma-the-husky
gemma-the-husky
P
Truncated file header
Replies
3
Views
335
Gasman
Gasman
P
Loop gets limited
2
Replies
25
Views
2,051
Pat Hartman
P
P
Error code solution
Replies
14
Views
1,230
Gasman
Gasman
N
Solved Failing To Save Imported Data from the internet in Ms Access
Replies
6
Views
599
nector
N

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom