File Spec

[Victor Moss]

I'm trying to create a file spec from a spreadsheet, although I'm constantly getting an "Invalid Procedure Call or Argument" error,

Please can someone help!?

Sub Macro3()



Dim columno As Integer
Dim rowno As Integer
Dim BlankValue As String
Dim BUFFER As String
Dim done As Boolean
Dim fpath As String
Dim Acdate As String
Dim FName As String
Dim msg As String
Dim CountRec As Integer
Dim TAmount As Integer


On Error GoTo errorhandler


    FName = "C:\TEST\" & InputBox("Please enter a file name.") & ".txt" ' & Format(Trim(Left(fpath, 8)), ">") & ".txt"
    Open FName For Output As #1
    
    CountRec = 0
    TAmount = 0
    
    Range("A3").Select
    rowno = 2
  
    Do Until done
    
     rowno = rowno + 1
        Range("A" & rowno).Select
         
        If ActiveCell.Value = "" Then
            done = True
            Exit Do
            
        Else
        'check if the value is zero
            Range("B" & rowno).Select
            If Val(ActiveCell.Value) = 0 Then    'NOTHING
                       
            Else
            
                CountRec = CountRec + 1

               
 '1-9  Transaction Number
                BlankValue = 8 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                BlankValue = 9 - Len(CountRec)
                BUFFER = BUFFER & Space(BlankValue) & Format(CountRec, "00000")

                
'10-13  Method of Payment
                BlankValue = 9 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue) & "2  "

               
 '13-15  Account Type
                BlankValue = 12 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue) & "1  "

               
 '16-23  From Branch code - A
                BlankValue = 15 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                Range("A" & rowno).Select
                BlankValue = 6 - Len(Trim(Left(ActiveCell.Value, 6)))
                BUFFER = BUFFER & Space(BlankValue) & Trim(ActiveCell.Value)

               
 '24-44  From Account number - B
                BlankValue = 23 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                Range("B" & rowno).Select
                BlankValue = 21 - Len(Trim(Left(ActiveCell.Value, 21)))
                BUFFER = BUFFER & Space(BlankValue) & Trim(ActiveCell.Value)

               
 '45-66  To Name - C
                BlankValue = 44 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                Range("C" & rowno).Select
                BlankValue = 22 - Len(Trim(Left(ActiveCell.Value, 22)))
                BUFFER = BUFFER & Format(Trim(Left(ActiveCell.Value, 22)) & Space(BlankValue), ">")

               
 '67-79  Amount - D
                BlankValue = 66 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                Range("D" & rowno).Select
                BlankValue = 13 - Len(Format((ActiveCell.Value), "##############0.00")) 'BlankValue = 13 - Len(Trim(ActiveCell.Value))
                BUFFER = BUFFER & Space(BlankValue) & Format(Trim(Trim(Val((ActiveCell.Value)))), "##############0.00") 'BUFFER = BUFFER & Space(BlankValue) & Trim(ActiveCell.Value) '(ActiveCell.Value)
                                
                TAmount = TAmount + Trim(ActiveCell.Value)

                
'80-96  To Description on Statement - E
                BlankValue = 79 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue)
                Range("E" & rowno).Select
                BlankValue = 17 - Len(Trim(Left(ActiveCell.Value, 20)))
                BUFFER = BUFFER & Format(Trim(Left(ActiveCell.Value, 20)) & Space(BlankValue), ">")

               
 '97  Print - ("N" for Ad-Hoc)
                BlankValue = 96 - Len(BUFFER)
                BUFFER = BUFFER & Space(BlankValue) & "N"
                
                'MsgBox BUFFER
                Print #1, BUFFER
                
        End If
        End If
       
    Loop
    
errorhandler:
    
     If Err.Number <> 0 Then
  
    MsgBox ("There is an Error in record " & rowno)
          
    msg = "Error # " & Str(Err.Number) & Chr(13) & Err.Description
    MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
    
      Close #1
      Kill FName
      Exit Sub
          
    End If

'Resume Next
End Sub

 

[Victor Moss]

Thank you Rosen. Just a question, for me to create a single text header (Row1) from Excel Row1, would that require it's own sub?

 

[Rosen]

Nope, it should be able to be placed in the same sub just before you start the loop of the body but after you have opened the stream to the file. But if it is going to be easier/cleaner to have it separated you can put it in its own sub, but it would require a parameter of the file index, which in my updated code is stored in the File variable... so if you have a Sub CreateHeader(ByVal FileIndex As Integer) would be called like this: CreateHeader File

 

[Victor Moss]

Hi Rosen, I would just like to thank you for all your help. I've spent the weekend and have finished building what I set out to build. The last advice you gave me works perfectly. If you don't mind, I have one last question, for me to create a footer, how would I have Excel write the last text line in notepad? It's the last thing I need to figure out or know for me to start my next project. Any help would be greatly appreciated.

 

[Rosen]

The footer is basically the same concept as the Header but at the end of your code, after the loop but before you close the file stream add the footer. Between the lines Loop and Close File