Extra to Text, Creating a new file with a unique name 1

[Losman500]

I copied this code which was posted by WinblowsME and modified it to serve my purpose. The only thing that I need is when running the macro instead of overwriting the text file I want to create a new file with the name of a string located in a specific location of the Extra screen or a unique value like a sequential number. Either way will work. Any thoughts?

Basically I want to scrape the current Extra screen, create a new text file and name the text file with a unique name from either a value in the Extra screen or a sequential number. This is the code so far

Declare Sub Wait()

GLOBAL Sys as Object
GLOBAL Sess as Object

Sub Main()
   Dim outfile As String, aline As String
   Dim i as Integer, iRows As Long, iCols As Long

   outfile = "C:\Documents and Settings\burnside_carlos\My Documents\Attachmate\EXTRA!\Scrape.txt"

   Set Sys = CreateObject("Extra.System")

   If Sys Is Nothing Then
      MsgBox ("Could not create Extra.System...is E!PC installed on this machine?")
      Exit Sub
   End If

   Set Sess = Sys.ActiveSession

   If Sess Is Nothing Then
      MsgBox ("No session available...stopping macro playback.")
      Exit Sub
   End If

   ' ###
   If UCase(Sess.Screen.GetString(1, 2, 4)) = "RGAM" Then

   iRows = Sess.Screen.Rows
   iCols = Sess.Screen.Cols

   Open outfile For Output As #1
      Do
         For i = 1 To iRows
            aline = UCase(Trim(Sess.Screen.GetString(i, 1, iCols)))

            Print #1, aline
         Next i

         Wait
         
      ' If line 24 contains "RET AUTH MAINT" stop the loop.      
      Loop While Trim(Sess.Screen.GetString(2, 1, iCols)) = "RETURN AUTHORIZATION MAINTENANCE"
   Close #1
   Else
      MsgBox "You must be in the RGAM screen to run macro."    ' Displays a message box if not in RGAM
   End If
End Sub

Sub Wait()
   Do While Sess.Screen.OIA.Xstatus <> 0
      DoEvents
   Loop
End Sub

 

[Skie]

Wrap it in a loop and basically...

outfile = "C:\Documents and Settings\burnside_carlos\My Documents\Attachmate\EXTRA!\Scrape"
outext = ".txt"
increment = 1

Open outfile & CStr(increment) & outext For Output As #1

Close #1

increment = increment + 1

If you're not going to be running it in a loop, then create a file that saves the value of increment and read/write it each time you run the code.

 

[Losman500]

I would rather not run it in a loop. How can I create a file that saves the value of increment? I know I still have to clean up my code, but when I used your code with a loop, it created a new file with the increment but did not write anything on the file. Just for learning purposes what did I miss?

Thanks in advance. This is what I have so far..

Declare Sub Wait()

GLOBAL Sys as Object
GLOBAL Sess as Object

Sub Main()
   Dim outfile As String, aline As String
   Dim i as Integer, iRows As Long, iCols As Long
   
   outfile = "C:\Documents and Settings\losman500\My Documents\Attachmate\EXTRA!\Scrape"
    outext = ".txt"
    increment = 1
    
    Open outfile & CStr(increment) & outext For Output As #1

    Close #1

    increment = increment + 1

   Set Sys = CreateObject("Extra.System")

   If Sys Is Nothing Then
      MsgBox ("Could not create Extra.System...is E!PC installed on this machine?")
      Exit Sub
   End If

   Set Sess = Sys.ActiveSession

   If Sess Is Nothing Then
      MsgBox ("No session available...stopping macro playback.")
      Exit Sub
   End If

   ' ###
   If UCase(Sess.Screen.GetString(1, 2, 4)) = "RGAM" Then

   iRows = Sess.Screen.Rows
   iCols = Sess.Screen.Cols

   Open outfile For Output As #1
      Do
         For i = 1 To iRows
            aline = UCase(Trim(Sess.Screen.GetString(i, 1, iCols)))

            Print #1, aline
         Next i

         Wait
         
      ' YOU'LL NEED ANOTHER CRITERIA TO STOP THE LOOP!
      ' If line 2 contains "RETURN AUTHORIZATION MAINTENANCE" stop the loop.      
      Loop While Trim(Sess.Screen.GetString(2, 1, iCols)) = "RETURN AUTHORIZATION MAINTENANCE"
   Close #1
   Else
      MsgBox "You must be in the RGAM screen to run macro."    ' Displays a message box if not in RGAM
   End If
End Sub

Sub Wait()
   Do While Sess.Screen.OIA.Xstatus <> 0
      DoEvents
   Loop
End Sub

 

[Skie]

Something like this...

Declare Sub Wait()

Const S_PATH = "C:\Temp\"
Dim Sys as Object
Dim Sess as Object

Sub Main()
    Dim inFile$, outFile$, aLine$
    Dim sDir$, sInc$, sJunk$, sPath$
    Dim i%, iRows%, iCols%

    sInc = "1"
    inFile = S_PATH & "ScrapeInc.txt"
    sDir = Dir(inFile, 0)
    If sDir <> "" Then
        Open inFile For Input As #1
            Do While EOF(1) = 0
                Line Input #1, sJunk
                If IsNumeric(sJunk) Then
                    sInc = sJunk
                End If
            Loop
        Close #1
    End If
   
    Set Sys = CreateObject("Extra.System")
    If Sys Is Nothing Then
        MsgBox ("Could not create Extra.System...is E!PC installed on this machine?")
        Exit Sub
    End If

    Set Sess = Sys.ActiveSession
    If Sess Is Nothing Then
        MsgBox ("No session available...stopping macro playback.")
        Exit Sub
    End If

    If UCase(Sess.Screen.GetString(1, 2, 4)) = "RGAM" Then
        iRows = Sess.Screen.Rows
        iCols = Sess.Screen.Cols

        outFile = S_PATH & "Scrape" & sInc & ".txt"
        Open outFile For Output As #1
            Do
                For i = 1 To iRows
                    aLine = UCase(Trim(Sess.Screen.GetString(i, 1, iCols)))
                    Print #1, aLine
                Next
                Wait
            Loop While Trim(Sess.Screen.GetString(2, 1, iCols)) = "RETURN AUTHORIZATION MAINTENANCE"
        Close #1
        
        Open inFile For OutPut As #1
            Print #1, CStr(CInt(sInc) + 1)
        Close #1
    Else
        MsgBox "You must be in the RGAM screen to run macro."
    End If
End Sub

Sub Wait()
    Do While Sess.Screen.OIA.Xstatus <> 0
        DoEvents
    Loop
End Sub

 

[Losman500]

This is very good. Thank you very much. I really need to learn how to program. Nobody at my job ever uses VB or EB for anything.

Thanks Skie