Part 4 to: Import more data into spreadsheet

uploading attachment again.FW-Sovereign-Gold-Card---Order-4.msg

hmmm... when I click on the attachment it doesn't open as an email for me. Does it for you?

yes the attachment opens in Excel as it is CSV but it does not open it in columns all goes in Col A
gowflow

yes, that's how I receive it, but when I open up the csv it looks like the attached.

yes correct, and this makes it a bit more manipulation than Excel as we need to go thru the items seuquentially to locate what we want.

Is this a real example ?? or just a file you made up ?? I cannot write a macro on suppositions I need a final format with some data there to be able to get you the correct data out.

Can you post some examples so I can work on ?

Also what would happen if you have both .xls and .csv in the attachment which one we look for to update the record ???

gowflow

we should only get either the csv OR the xls file in one email, not both in the same email.( The csv file comes from a web order and the xls file comes in reply to me sending it out for the applicant to fill out and return.)

the example sent is a real example where I just changed names and numbers

what further examples are you needing? I posted the csv file.

ok here it is this should deal with both scenarios. The only thing remaining is that in csv I do not know where the Card number come at what location as the code you posted had not this info.

check it out and let me know.

1) Make a copy of ur latest file and give it a new name.
2) goto vba and delete SaveAttachements and replace it by the below version.

Public Sub SaveAttachments()
On Error GoTo ErrHandler

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim I As Long, J As Long, K As Long
Dim lngCount As Long
Dim LastRow As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim cCell As Range
Dim WS As Worksheet
Dim FileExt As String
Dim AttachRange As Range
Dim WB As Workbook
Dim WSAttach As Worksheet
Dim X, sFields
Dim ValidFile As Boolean

    Set WS = ActiveSheet
        
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    'On Error Resume Next
 
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
 
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    'Set objSelection = objOL.GetNamespace("MAPI").Folders("CM Template")
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
 
    ' Set the Attachment folder to be this specific path as per Jaset request on Apr 29, 2013
    strFolderpath = strFolderpath & "\OLAttachments"
    'strFolderpath = "C:\Users\Michael\Sovereign Archives"
    
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
 
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
         
        '---> Choose the color of the row
        Set cCell = ActiveCell
        LastRow = cCell.Row + 1
        Do
            '---> Locate the cell color of the last row above the current one
            LastRow = LastRow - 1
            LastRow = WS.Range("A" & LastRow).End(xlUp).Row
            
        Loop Until WS.Range("A" & LastRow).Interior.Color <> 16777215 Or LastRow = 1
        
        '---> Color the new row based on the results
        If WS.Range("A" & LastRow).Interior.Color = 14545386 Then
            WS.Range("A" & cCell.Row & ":AB" & cCell.Row).Interior.Color = 10147522
        Else
            WS.Range("A" & cCell.Row & ":AB" & cCell.Row).Interior.Color = 14545386
        End If
         
        If lngCount > 0 Then
            ' Use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.
            K = 0
            For I = lngCount To 1 Step -1
             
                ' Get the file name.
                strFile = objAttachments.Item(I).FileName
                 
                ' Combine with the path to the Temp folder.
                strFile = strFolderpath & "\" & strFile
                 
                ' Save the attachment as a file.
                Application.DisplayAlerts = False
                
                On Error Resume Next
                Do
                    objAttachments.Item(I).SaveAsFile strFile
                    
                    If Err <> 0 Then
                        MkDir (Left(strFile, InStrRev(strFile, "\")))
                    Else
                        On Error GoTo 0
                    End If
                Loop Until Err = 0
                
                        
                '---> Insert data in coresponding cells
                Do Until WS.Cells(cCell.Row, K + 5) = ""
                    If K + 6 = 9 Then
                        '---> Copy Insert the new row and contine in Cell E
                        WS.Cells(cCell.Row, K + 5).EntireRow.Copy
                        WS.Cells(cCell.Row, K + 5).EntireRow.Insert
                        WS.Range("E" & cCell.Row & ":H" & cCell.Row).ClearContents
                        K = -1
                    End If
                    K = K + 1
                Loop
                WS.Range("A" & cCell.Row) = objMsg.ReceivedTime
                WS.Range("D" & cCell.Row) = objMsg.SenderEmailAddress
                
                WS.Range(WS.Cells(cCell.Row, K + 5), WS.Cells(cCell.Row, K + 5)).Formula = "=hyperlink(" & Chr(34) & strFile & Chr(34) & "," & Chr(34) & Right(strFile, Len(strFile) - InStrRev(strFile, "\")) & Chr(34) & ")"
                
                FileExt = LCase(Right(strFile, Len(strFile) - InStrRev(LCase(strFile), ".", Len(strFile))))
                
                '---> Check to See if Valid Excel File
                If InStr(1, FileExt, "xls") <> 0 Or InStr(1, FileExt, "xlsm") <> 0 Or InStr(1, FileExt, "xltx") <> 0 Or InStr(1, FileExt, "xlsx") <> 0 Then
                    '---> Open Workbook
                    Application.DisplayAlerts = False
                    Application.ScreenUpdating = False
        
                    Set WB = Workbooks.Open(strFile)
                    Set WSAttach = WB.ActiveSheet
                                
                    '---> Test to see if Valid CC File
                    'If WSAttach.Range("P1") <> "" Then
                    If WSAttach.Range("A1") = "First Name" And WSAttach.Range("B1") = "Last Name" And WSAttach.Range("O1") = "Email Address" Then
                        '---> We are Dealing with Horizontal Spreadsheet
                        '     Assign Col A to Col C as First Name
                        '     Assign Col B to Col B as Last Name
                        WS.Range("C" & cCell.Row) = WSAttach.Range("A2")
                        WS.Range("B" & cCell.Row) = WSAttach.Range("B2")

                        
                        '---> Depending on Value of Col P affect Col T
                        If WSAttach.Range("P1") = "Card Number" Then
                            WS.Range("T" & cCell.Row).NumberFormat = "Text"
                            WS.Range("T" & cCell.Row) = WSAttach.Range("P2")
                        Else
                            WS.Range("T" & cCell.Row) = "Not Yet Assigned"
                        End If
                    Else
                        '---> We are Dealing with Vertical Spreadsheet
                        '     Assign B1 to Col C as First Name
                        '     Assign B2 to Col B as Last Name
                        '     Col T = 'Not Yet Assigned'
                        WS.Range("B" & cCell.Row) = WSAttach.Range("B2")
                        WS.Range("C" & cCell.Row) = WSAttach.Range("B1")
                        WS.Range("T" & cCell.Row) = "Not Yet Assigned"
                    End If
                
                    '---> Close Workbook
                    WB.Close SaveChanges:=False
                    Set WSAttach = Nothing
                    Set WB = Nothing
        
                    Application.DisplayAlerts = False
                    Application.ScreenUpdating = False
        
                
                Else
                
                    '---> Check to see if Valid .csv file
                    If InStr(1, FileExt, "csv") <> 0 Then
                        '---> Open Workbook
                        Application.DisplayAlerts = False
                        Application.ScreenUpdating = False
            
                        Open strFile For Input As #1
                        
                        '---> Read the Header
                        Line Input #1, X
                        sFields = Split(X, ",")
                        
                        '---> Test to see if Valid File
                        If InStr(1, sFields(0), "First Name") <> 0 And InStr(1, sFields(1), "Last Name") <> 0 And InStr(1, sFields(7), "Email Address") <> 0 Then
                            Line Input #1, X
                            sFields = Split(X, ",")
                            
                            '---> Strip quotes prior affecting
                            X = ""
                            For J = 1 To Len(sFields(0))
                                If Mid(sFields(0), J, 1) <> Chr(34) Then
                                    X = X & Mid(sFields(0), J, 1)
                                End If
                            Next J
                            sFields(0) = X
                            
                            X = ""
                            For J = 1 To Len(sFields(1))
                                If Mid(sFields(1), J, 1) <> Chr(34) Then
                                    X = X & Mid(sFields(1), J, 1)
                                End If
                            Next J
                            sFields(1) = X
                            
                            WS.Range("C" & cCell.Row) = sFields(0)
                            WS.Range("B" & cCell.Row) = sFields(1)
                        End If
                        
                        '---> Close the File
                        Close #1
                        Application.DisplayAlerts = False
                        Application.ScreenUpdating = False
                    End If
                    
                End If
                
                
            Next I
            
            '---> Check after all Attachements if Still Col T Empty
            '     then update with Not Yet Assigned.
            '     to ensure Col T always Updated with value
            If WS.Range("T" & cCell.Row) = "" Then
                WS.Range("T" & cCell.Row) = "Not Yet Assigned"
            End If
            
        Else
            '---> Update Email, Date, CC Even if no attachements
            WS.Range("A" & cCell.Row) = objMsg.ReceivedTime
            WS.Range("D" & cCell.Row) = objMsg.SenderEmailAddress
            WS.Range("T" & cCell.Row) = "Not Yet Assigned"
        End If
        
        '---> Move ActiveCell 1 row
        WS.Cells(cCell.Row + 1, 1).Select
        
    Next objMsg

Application.DisplayAlerts = True
Application.ScreenUpdating = True
DoEvents
MsgBox (lngCount & " Attachments were saved on C drive")


ExitSub:
 
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Exit Sub

ErrHandler:
X = MsgBox("This Routine will Exit due to following Error:" & Chr(10) & Chr(10) & Error(Err), vbCritical)
GoTo ExitSub


End Sub

 

Select allOpen in new window

3) SAVE and Exit the workbook
4) Try it

let me know
gowflow

thanks gowflow, will try it out. the csv format will not have a card number

just tried 4 orders, 3 with with csv formatted and 1 with xls formatted spreadsheets and unfortunately none of them imported the first and last name

pls post them as it works fine here. post as .msg
gowflow

I'm posting a screenshot, scrubbed, of one of the csv files to see if this will show you something you need to see before I have to go thru the emails and scrub . Let me know if this will work or if you need the actual emails.

I need the mails.
gowflow

what is a personal email address I can these emails to?

FW-Sovereign-Gold-Card---Order-4.msg
FW-Sovereign-Gold-Card---Order-4.msg
FW-Sovereign-Gold-Card---Order-4.msg
FW-New-order-with-DC.msg
FW-Re14-Customer-interested-in-a.msg

I have tried all of them and they worked perfectly fine. It seems you are messed up with the versions. Recopy the last sub I posteted above.
gowflow

deleted previous code and inserted the code above. closed and reopened. ran the code and got the errors posted. the error popped up after trying to process the email that had one of the above emails attached, which I attach again.

It imported the files correctly, but not the first and last name nor the 'not assigned yet' value before it choked.FW-Sovereign-Gold-Card---Order-4.msg

Weired !!!! I tried it several times as you can see in the snapshot and it import fine and works fine.


What version of Excel are you using maybe some other incompatibility !!! ???
gowflow

2010 - I'll try it again - have to step out for an hour

I tried it on 2003 and 2007 and no problem. This was my fear so many incompatibilities on several levels in 2010. Give it an other try and let me know. I presently do not hv 2010 but just purchased it recently. If needed I will install it and check it out.

gowflow

just tried function again on another email, getting same error as above

  '---> Test to see if Valid File
                        If InStr(1, sFields(0), "First Name") <> 0 And InStr(1, sFields(1), "Last Name") <> 0 And InStr(1, sFields(7), "Email Address") <> 0 Then
                            Line Input #1, X
                            sFields = Split(X, ",")

got anything for me gowflow? or maybe I should go back to the earlier function

Well did not install 2010 yet as seems its an issue with that. Do you hv 2007 or 2003 on ur pc ? if yes can you just test this file with one of the 2 versions and see if you still hv the same issue ?
gowflow

no, don't have those anymore. so what do you think of the error I'm getting? nothing can be done with that?

I do not get this error !!!! this error means that we are executing a read after the end of file which is absurd as we open the file then make 1 read to read the header then when reading the next line we got that it is past end of file although we know that the file has 2 lines !!!!

Let me try something else here and will get back.
gowflow

I don't know if this will do it but we can try it its no harm. Do the folllowing:

1) open the file
2) goto vba
3) locate the sub SaveAttachements
4) locate this line:
Open strFile For Input As #1

5) comment it out (put a single quote just before the open so it become like this
'Open strFile For Input As #1

6) Paste the below line just after the previous one
Open strFile For Binary As #1

7) SAVE and Exit the workbook.
8) open it and try it and see if you still have the same error.

gowflow

well it worked for the xls file, even for an email that had two of them, but still same error with csv file

ok I will research the net ull hv to be patient. will revert. Tough when u don't get the error diffcult to reproduce it. Will revert.
gowflow

do you want me to send my spreadsheet?

it is posted. as you can see I have 3 sheets in the workbook. not sure if that makes any difference.

Scrubbed-APPLICANT-STATUS-6-6-13.xls

doesn't make a diffrence. It still works here on your file. I am sure it is something with a caracter that is taking both lines in 1 reason why it is hitting end of file on the second read. But can't troubleshoot it with you as it need to make a stop in the code and get the value which is difficult to do remotly.

One last question the email you are trying to import is exactly the same as you have send me or you manipulated the one you send me earlier ??? as this may be the issue. I need the exact same email you are working on to see what is the problem.

gowflow

I will send you an unadulterated email with no alterations, but I have to send it your private email address. I can't post it here.

try this

1) Make a new copy of the workbook giving it a new name
2) goto vba and delete SaveAttachements
3) Paste the below code after any End Sub

Public Sub SaveAttachments()
On Error GoTo ErrHandler

Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim I As Long, J As Long, K As Long
Dim lngCount As Long
Dim LastRow As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
Dim cCell As Range
Dim WS As Worksheet
Dim FileExt As String
Dim AttachRange As Range
Dim WB As Workbook
Dim WSAttach As Worksheet
Dim X, sFields
Dim ValidFile As Boolean
Dim sLine As String

    Set WS = ActiveSheet
        
    ' Get the path to your My Documents folder
    strFolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
    'On Error Resume Next
 
    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")
 
    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection
    'Set objSelection = objOL.GetNamespace("MAPI").Folders("CM Template")
    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice
 
    ' Set the Attachment folder to be this specific path as per Jaset request on Apr 29, 2013
    strFolderpath = strFolderpath & "\OLAttachments"
    'strFolderpath = "C:\Users\Michael\Sovereign Archives"
    
    ' Check each selected item for attachments.
    For Each objMsg In objSelection
 
        Set objAttachments = objMsg.Attachments
        lngCount = objAttachments.Count
         
        '---> Choose the color of the row
        Set cCell = ActiveCell
        LastRow = cCell.Row + 1
        Do
            '---> Locate the cell color of the last row above the current one
            LastRow = LastRow - 1
            LastRow = WS.Range("A" & LastRow).End(xlUp).Row
            
        Loop Until WS.Range("A" & LastRow).Interior.Color <> 16777215 Or LastRow = 1
        
        '---> Color the new row based on the results
        If WS.Range("A" & LastRow).Interior.Color = 14545386 Then
            WS.Range("A" & cCell.Row & ":AB" & cCell.Row).Interior.Color = 10147522
        Else
            WS.Range("A" & cCell.Row & ":AB" & cCell.Row).Interior.Color = 14545386
        End If
         
        If lngCount > 0 Then
            ' Use a count down loop for removing items
            ' from a collection. Otherwise, the loop counter gets
            ' confused and only every other item is removed.
            K = 0
            For I = lngCount To 1 Step -1
             
                ' Get the file name.
                strFile = objAttachments.Item(I).Filename
                 
                ' Combine with the path to the Temp folder.
                strFile = strFolderpath & "\" & strFile
                 
                ' Save the attachment as a file.
                Application.DisplayAlerts = False
                
                On Error Resume Next
                Do
                    objAttachments.Item(I).SaveAsFile strFile
                    
                    If Err <> 0 Then
                        MkDir (Left(strFile, InStrRev(strFile, "\")))
                    Else
                        On Error GoTo 0
                    End If
                Loop Until Err = 0
                
                        
                '---> Insert data in coresponding cells
                Do Until WS.Cells(cCell.Row, K + 5) = ""
                    If K + 6 = 9 Then
                        '---> Copy Insert the new row and contine in Cell E
                        WS.Cells(cCell.Row, K + 5).EntireRow.Copy
                        WS.Cells(cCell.Row, K + 5).EntireRow.Insert
                        WS.Range("E" & cCell.Row & ":H" & cCell.Row).ClearContents
                        K = -1
                    End If
                    K = K + 1
                Loop
                WS.Range("A" & cCell.Row) = objMsg.ReceivedTime
                WS.Range("D" & cCell.Row) = objMsg.SenderEmailAddress
                
                WS.Range(WS.Cells(cCell.Row, K + 5), WS.Cells(cCell.Row, K + 5)).Formula = "=hyperlink(" & Chr(34) & strFile & Chr(34) & "," & Chr(34) & Right(strFile, Len(strFile) - InStrRev(strFile, "\")) & Chr(34) & ")"
                
                FileExt = LCase(Right(strFile, Len(strFile) - InStrRev(LCase(strFile), ".", Len(strFile))))
                
                '---> Check to See if Valid Excel File
                If InStr(1, FileExt, "xls") <> 0 Or InStr(1, FileExt, "xlsm") <> 0 Or InStr(1, FileExt, "xltx") <> 0 Or InStr(1, FileExt, "xlsx") <> 0 Then
                    '---> Open Workbook
                    Application.DisplayAlerts = False
                    Application.ScreenUpdating = False
        
                    Set WB = Workbooks.Open(strFile)
                    Set WSAttach = WB.ActiveSheet
                                
                    '---> Test to see if Valid CC File
                    'If WSAttach.Range("P1") <> "" Then
                    If WSAttach.Range("A1") = "First Name" And WSAttach.Range("B1") = "Last Name" And WSAttach.Range("O1") = "Email Address" Then
                        '---> We are Dealing with Horizontal Spreadsheet
                        '     Assign Col A to Col C as First Name
                        '     Assign Col B to Col B as Last Name
                        WS.Range("C" & cCell.Row) = WSAttach.Range("A2")
                        WS.Range("B" & cCell.Row) = WSAttach.Range("B2")

                        
                        '---> Depending on Value of Col P affect Col T
                        If WSAttach.Range("P1") = "Card Number" Then
                            WS.Range("T" & cCell.Row).NumberFormat = "Text"
                            WS.Range("T" & cCell.Row) = WSAttach.Range("P2")
                        Else
                            WS.Range("T" & cCell.Row) = "Not Yet Assigned"
                        End If
                    Else
                        '---> We are Dealing with Vertical Spreadsheet
                        '     Assign B1 to Col C as First Name
                        '     Assign B2 to Col B as Last Name
                        '     Col T = 'Not Yet Assigned'
                        WS.Range("B" & cCell.Row) = WSAttach.Range("B2")
                        WS.Range("C" & cCell.Row) = WSAttach.Range("B1")
                        WS.Range("T" & cCell.Row) = "Not Yet Assigned"
                    End If
                
                    '---> Close Workbook
                    WB.Close SaveChanges:=False
                    Set WSAttach = Nothing
                    Set WB = Nothing
        
                    Application.DisplayAlerts = False
                    Application.ScreenUpdating = False
        
                
                Else
                
                    '---> Check to see if Valid .csv file
                    If InStr(1, FileExt, "csv") <> 0 Then
                        '---> Open Workbook
                        Application.DisplayAlerts = False
                        Application.ScreenUpdating = False
            
                        Open strFile For Input As #1
                        'Open strFile For Binary As #1
                        '---> Read the Header
                        Line Input #1, sLine
                        sFields = Split(sLine, ",")
                        
                        '---> Test to see if Valid File
                        If InStr(1, sFields(0), "First Name") <> 0 And InStr(1, sFields(1), "Last Name") <> 0 And InStr(1, sFields(7), "Email Address") <> 0 Then
                            Line Input #1, sLine
                            sFields = Split(sLine, ",")
                            
                            '---> Strip quotes prior affecting
                            X = ""
                            For J = 1 To Len(sFields(0))
                                If Mid(sFields(0), J, 1) <> Chr(34) Then
                                    X = X & Mid(sFields(0), J, 1)
                                End If
                            Next J
                            sFields(0) = X
                            
                            X = ""
                            For J = 1 To Len(sFields(1))
                                If Mid(sFields(1), J, 1) <> Chr(34) Then
                                    X = X & Mid(sFields(1), J, 1)
                                End If
                            Next J
                            sFields(1) = X
                            
                            WS.Range("C" & cCell.Row) = sFields(0)
                            WS.Range("B" & cCell.Row) = sFields(1)
                        End If
                        
                        '---> Close the File
                        Close #1
                        Application.DisplayAlerts = False
                        Application.ScreenUpdating = False
                    End If
                    
                End If
                
                
            Next I
            
            '---> Check after all Attachements if Still Col T Empty
            '     then update with Not Yet Assigned.
            '     to ensure Col T always Updated with value
            If WS.Range("T" & cCell.Row) = "" Then
                WS.Range("T" & cCell.Row) = "Not Yet Assigned"
            End If
            
        Else
            '---> Update Email, Date, CC Even if no attachements
            WS.Range("A" & cCell.Row) = objMsg.ReceivedTime
            WS.Range("D" & cCell.Row) = objMsg.SenderEmailAddress
            WS.Range("T" & cCell.Row) = "Not Yet Assigned"
        End If
        
        '---> Move ActiveCell 1 row
        WS.Cells(cCell.Row + 1, 1).Select
        
    Next objMsg

Application.DisplayAlerts = True
Application.ScreenUpdating = True
DoEvents
MsgBox (lngCount & " Attachments were saved on C drive")


ExitSub:
 
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Exit Sub

ErrHandler:
X = MsgBox("This Routine will Exit due to following Error:" & Chr(10) & Chr(10) & Error(Err), vbCritical)
GoTo ExitSub


End Sub

 

Select allOpen in new window

4) SAVE and Exit the workbook
5) Open it and try it.

gowflow

no do not send to private email please will work at it
gowflow

Then you are confirming that you altered the csv ??? if yes please tell me you opened it in Excel then removed the sensitive data then closed it again and attached it to the email ? Is that what you did ????
gowflow

yes, I had to take out sensitive info in the versions I sent you, but I tried to just alter the names and numbers, but I did that to all of them I sent. and yes, I had to save the csv to my computer and then reattach and resend to myself then post it here

let me do this. I'll create an order myself so that it has my bogus data and then forward the email to you directly without changing anything. will that do?

ok fine and all changes were done in the Excel right like when you doubleclicked on the file it opened it in Excel and this is where you made your changes and saved it back to csv right ???
gowflow

right - all done in excel

I will send you an untouched email soon

tried new code, get same error right away with csv file

DO NOT SEND ON MY PRIVATE MAIL !!!!! PLEASE
gowflow

please confirm you will not send to my mail so I continue with the troubleshoting steps or else I will stop assistance rightaway.
gowflow

will not do. I'll just post it here.

no need. I will give you following steps to do
gowflow

First open your file and goto vba and display the Saveattachments sub and goto the line in the below picture that is in brown and click on that line and then press F9 it will turn brown


Then goback to your worksheet and make sure the culprit email is highlighted in outlook and then click on the button Save Links.

The program will stop at this line and it will turn yellow thats ok. Now as you can see in the following picture under the code there is a window called Immediate window if it is not displayed like in the attached picture then go on the View Menu and choose Immediate Window and it will be displayed. Type what ever you see in the picture
? sLine
then press enter
it is supposed to display the first line of the file. Please look at the data and see if it is the first line or both lines ???


Now again look at the below picture you will see an other instruction I need you to revert with the results
?instr(1,sLine,Chr(13))
then press Enter

do you get 0 ? do you get and other figure what is it ?



Will wait for your answers.
gowflow

first command: 2 lines, both lines
second command: 0

thought so !!!! and this is the problem and reason why you get past end of file as when it hits the next Line Input you are already at the end of the file.

OK I need the following now

your yellow line is still at the instruction
sFields = Split(sLine, ",")

I want you to try this instruction
?instr(1,sLine,chr(10))

and tell me what you get ?
gowflow

comes back: 212

mmmm GREAT !!!!

now try your end
?mid(sLine,1,212)

it should give you the header

then
?mid(sLine,212,Len(sLine)-212))

it should give you the data or the second line (+/- 1 character or so but roughly this)

pls advise
gowflow

?mid(sLine,1,212)  gives me the header

?mid(sLine,212,Len(sLine)-212)) gives me  "compile error: Expected: expression"

ok then try

?Len(sLine)

gowflow

get: 393

Sovereign-Gold-Card---Order-485-.msg

attached is an original email unaltered. don't know if it will help

Victory!!!

It now works on csv and xls files!

You worked for this one! Thank you.

Welcome and tks. Pls feel free to post and other issue you may need help with in here.
gowflow

thank you, gowflow. I really appreciate the help. The next one is going further with the Applicant Status sheet

It is here:

https://www.experts-exchange.com/questions/28150848/Part-5-to-Import-more-data-into-spreadsheet.html

Thanks again, gowflow.