0

enter image description hereI have an XL file which has some data validation linked to a list of G/L accounts and Departments, as well as periods. The goal is for the user to select their choice, and for the .sql file to dynamically update the code and using ADO output the query to another workbook with the parameterized data. Unfortunately when I am doing the loop of the text stream, the .AtEndofText property is switching to true on blank lines of the .sql file and the loop dies there (line 9 , for example).

Is there an easier way to do this ? Ie. continue to loop through blank lines?

Or do I have to simply modify my .sql file to remove all blank lines?

Thank you

Option Explicit

Option Base 1

Private Sub Get_and_LoadData()

Dim S As Worksheet, LO As ListObject, Arr() As Variant, NB As Workbook
Dim B As Workbook
Dim fPath  As String, FSO As FileSystemObject, sFile As TextStream
Dim sSQL As Variant, x As Long
Dim aConn As Object, aComm As Object, aRec As Object, ConnSTR As String
Dim fDir As String, tempFile As String
Dim nFile As TextStream

On Error GoTo sqlErr

'Set objects
fPath = "\\silica\vol11\Groups\Finance\Ops Finance\Reporting\F18 Financials\LN_Data_Lookup\SQL_Pull Financial Data_V2.sql"
Set B = ThisWorkbook
Set FSO = New FileSystemObject
Set aConn = VBA.CreateObject("ADODB.Connection")
Set aComm = VBA.CreateObject("ADODB.Command")
Set aRec = VBA.CreateObject("ADODB.Recordset")
Set S = ShTitle
Set LO = S.ListObjects("ParameterTable")

'Array for Parameters (The "Set" Statements range)
Arr = LO.DataBodyRange.offset(, 10)

'Check for source file existence
If VBA.Dir$(fPath, vbNormal) = "" Then
    MsgBox "No .Sql file!", vbExclamation, "Ensure file exists.."
    Exit Sub
Else
    fDir = B.Path & "\"
End If

'Set file system objects
Set sFile = FSO.OpenTextFile(Filename:=fPath, IOMode:=ForReading, _
Create:=False)
tempFile = fDir & "temp" & VBA.Replace(Timer, ".", "") & ".txt"
Set nFile = FSO.CreateTextFile(Filename:=tempFile)

'Get SQL Script
'sSQL = sFile.ReadAll   'read file contents into a variable

'Update SQL SCRIPT
Do Until sFile.AtEndOfStream = True

    'Loop through the lines of the text stream
    Do Until sFile.AtEndOfLine = True

        'Note these are the lines where the SET statements exist
        If sFile.line >= 8 And sFile.line <= 14 Then

            x = x + 1
            nFile.WriteLine Arr(x, 2)
            sFile.SkipLine 'to jump to next line

        ElseIf sFile.line = 65 Or sFile.line = 66 Then 'comment out parameters not used

            nFile.WriteLine "-- " & sFile.ReadLine

        Else

            nFile.WriteLine sFile.ReadLine  'Updates .Line property

        End If

    Loop
   ' x = 0

Loop

'Get connection string to DB
ConnSTR = getConnection(ConnSTR)

'Open connection to the Database
aConn.Open ConnSTR
aConn.defaultdatabase = "ln"

'Load the sql command into an object
With aComm
.ActiveConnection = ConnSTR
.CommandText = sSQL
.CommandTimeout = 300  '5 minute QRY execution max
End With

'Load the record Set
Set aRec = aComm.Execute(sSQL)

'Kill the temp .txt file
Kill tempFile

'Output the record set to new workbook
Set NB = Application.Workbooks.Add
NB.Sheets(1).Range("A1").CopyFromRecordset aRec

'Delete from MEMORY
Set nFile = Nothing
Set aConn = Nothing
Set aComm = Nothing
Set aRec = Nothing
Set sFile = Nothing
sSQL = vbNullString
Set FSO = Nothing
Set B = Nothing
Set NB = Nothing
Set LO = Nothing
Erase Arr
Set S = Nothing

Exit Sub

sqlErr:
MsgBox Err.Description, vbExclamation

End Sub


Function getConnection(conn As String) As String

'LN Connection
getConnection = "Provider=SQLOLEDB.1;Integrated Security=SSPI;" & _
"Persist Security Info=True;Initial Catalog=ln;Data Source=erpdbsvr1\erpln;" & _
"Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;" & _
"Workstation ID=" & LCase(Environ("username")) & "-LT;Use Encryption for Data=False;" & _
"Tag with column collation when possible=False;Trusted_connection=yes;"

End Function
3
  • Not sure you need this loop - Do Until sFile.AtEndOfLine = True That's what's giving you problems with empty lines. Commented Nov 26, 2018 at 19:27
  • @TimWilliams the thing is I need to change the string to base it of user parameters, so I wouldn't know how to do it via .readall Commented Nov 26, 2018 at 19:29
  • 1
    You already have the outer Do Until sFile.AtEndOfStream = True loop - just remove the inner AtEndOfLine loop Commented Nov 26, 2018 at 19:33

1 Answer 1

1

Something more like this (following from my comments above)

Dim inLine
'...
'...
Do Until sFile.AtEndOfStream = True
    inLine = sFile.ReadLine
    If sFile.Line >= 8 And sFile.Line <= 14 Then
        x = x + 1
        nFile.WriteLine Arr(x, 2)
    ElseIf sFile.Line = 65 Or sFile.Line = 66 Then
        nFile.WriteLine "-- " & inLine 'comment out parameters not used
    Else
        nFile.WriteLine inLine
    End If
Loop
Sign up to request clarification or add additional context in comments.

1 Comment

This worked thanks. Now I understand why it was stopping. Still learning to navigate the FSO. It's pretty powerful. Thanks Tim.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.