Trying to use Freefile function

**Euler271** · 05-06-2020, 11:55 AM

I'm trying to use the freefile function for the first time and it doesn't work as I need it to.

I have to go through the same code twice and I want it to either generate a new number each time or after I close the first one, generate the first one again and run.

I always get the errors 52 (Bad file name or number) or 55 (file already open).

Here's some of the code:

Select Case Ordinal
Case "First"
Set xlWb1 = xlApp.Workbooks.Add
Set xlWs = xlWb1.ActiveSheet
FileNumber = FreeFile
Case "Second"
Set xlWb3 = xlApp.Workbooks.Add
Set xlWs = xlWb3.ActiveSheet
FileNumber = FreeFile

End Select
Open lSQLFolder & strFile For Input Access Read As #FileNumber
While Not EOF(FileNumber)
Line Input #FileNumber, WholeLine
If Right(WholeLine, 1) <> "~" Then WholeLine = WholeLine & " " & "~"
Pos = 1
NextPos = InStr(Pos, WholeLine, "~")
WholeParagraph = WholeParagraph + Mid(WholeLine, 1, NextPos - 1)
While NextPos >= 1
Pos = NextPos + 1
NextPos = InStr(Pos, WholeLine, "~")
Wend
Wend
Close #FileNumber

Can someone tell me how to do this properly? Thanks.

**June7** · 05-06-2020, 01:00 PM

In future, please post code between CODE tags to retain indentation and readability.

Need more code. How are you running code twice? Need variable declarations and settings. Why are Excel objects set?

I found example code using FreeFile that creates text files. What are you trying to accomplish?

**Euler271** · 05-06-2020, 01:41 PM

Here is the code:

Code:

Private Sub Step1(Qname As String, Ordinal As String, CID As String) 'This calls the query and fills the worksheet.
    Dim adoRS As New ADODB.Recordset
    Dim i As Integer
    Dim strFile As String
    'This gets the query text.
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim WholeParagraph As String
    Dim FileNumber As Integer
    Select Case Ordinal
        Case "First"
            Set xlWb1 = xlApp.Workbooks.Add
            Set xlWs = xlWb1.ActiveSheet
            FileNumber = FreeFile
        Case "Second"
            Set xlWb3 = xlApp.Workbooks.Add
            Set xlWs = xlWb3.ActiveSheet
            FileNumber = FreeFile
    End Select
    adoRS.Open lProdConn
    adoRS.MoveFirst
    While Not adoRS.EOF
        connString = connString & adoRS.Fields(0).value & " = '" & adoRS.Fields(1).value & "';"
        adoRS.MoveNext
    Wend
    adoRS.Close
    Set adoRS = Nothing
    varReturn = SysCmd(acSysCmdSetStatus, "Retrieving data...")
    DoEvents
    strFile = Dir(lSQLFolder & Qname)
    strSQL = ""
    On Error GoTo EndMacro
    Open lSQLFolder & strFile For Input Access Read As #FileNumber
    While Not EOF(FileNumber)
        Line Input #FileNumber, WholeLine
        If Right(WholeLine, 1) <> "~" Then WholeLine = WholeLine & " " & "~"
        Pos = 1
        NextPos = InStr(Pos, WholeLine, "~")
        WholeParagraph = WholeParagraph + Mid(WholeLine, 1, NextPos - 1)
        While NextPos >= 1
            Pos = NextPos + 1
            NextPos = InStr(Pos, WholeLine, "~")
        Wend
    Wend
    strSQL = WholeParagraph 'end result of this block of code - a copy of the SQL from the .sql file itself
    strSQL = Replace(strSQL, "strParam1", CID)
    Set ADOconn = New ADODB.Connection
    With ADOconn
        .CursorLocation = adUseClient
        'The next line is where it fails if locked out.
        .Open connString
        .CommandTimeout = 0
        Set rst = .Execute(strSQL)
    End With
    xlWs.Activate
    With rst
        'Populate field headers.
        For i = 1 To .Fields.Count: xlWs.Cells(1, i) = .Fields(i - 1).Name: Next i
        'Copy data to A2.
        xlWs.Range("A2").CopyFromRecordset rst
    End With
    rst.Close
    Set rst = Nothing
    Close #FileNumber
    Exit Sub
EndMacro:
    Select Case Err.Number
        'Case -2147467259
        '    MsgBox "The database is unavailable right now.", vbOKOnly, "Optum"
        Case Else
            MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Optum"
    End Select
    On Error GoTo 0
End Sub

How am I running code twice? I'm calling it twice from another procedure.
Excel objects are set because I need two different workbooks at once.

**June7** · 05-06-2020, 02:35 PM

I can't even compile your code because of all the "Variable not defined" errors. I always use Option Explicit in module headers.

Disable error handler code, set breakpoint, step debug.

**Euler271** · 05-06-2020, 03:02 PM

The code is one procedure out of several in the same module.
Many of the variables are declared at the top of the module.
Here is the code again with the variables within the compiled code;

Code:

Private Sub Step1(Qname As String, Ordinal As String, CID As String) 'This calls the query and fills the worksheet.
    Dim connString As String
    Dim strSQL As String
    Dim ADOconn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim xlApp As Excel.Application
    Dim xlWb1 As Excel.Workbook
    Dim xlWb3 As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim varReturn As Variant
    Dim adoRS As New ADODB.Recordset
    Dim i As Integer
    Dim strFile As String
    'This gets the query text.
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim WholeParagraph As String
    Dim FileNumber As Integer
    Select Case Ordinal
        Case "First"
            Set xlWb1 = xlApp.Workbooks.Add
            Set xlWs = xlWb1.ActiveSheet
            FileNumber = FreeFile
        Case "Second"
            Set xlWb3 = xlApp.Workbooks.Add
            Set xlWs = xlWb3.ActiveSheet
            FileNumber = FreeFile
    End Select
    adoRS.Open lProdConn
    adoRS.MoveFirst
    While Not adoRS.EOF
        connString = connString & adoRS.Fields(0).value & " = '" & adoRS.Fields(1).value & "';"
        adoRS.MoveNext
    Wend
    adoRS.Close
    Set adoRS = Nothing
    varReturn = SysCmd(acSysCmdSetStatus, "Retrieving data...")
    DoEvents
    strFile = Dir(lSQLFolder & Qname)
    strSQL = ""
    On Error GoTo EndMacro
    Open lSQLFolder & strFile For Input Access Read As #FileNumber
    While Not EOF(FileNumber)
        Line Input #FileNumber, WholeLine
        If Right(WholeLine, 1) <> "~" Then WholeLine = WholeLine & " " & "~"
        Pos = 1
        NextPos = InStr(Pos, WholeLine, "~")
        WholeParagraph = WholeParagraph + Mid(WholeLine, 1, NextPos - 1)
        While NextPos >= 1
            Pos = NextPos + 1
            NextPos = InStr(Pos, WholeLine, "~")
        Wend
    Wend
    strSQL = WholeParagraph 'end result of this block of code - a copy of the SQL from the .sql file itself
    strSQL = Replace(strSQL, "strParam1", CID)
    Set ADOconn = New ADODB.Connection
    With ADOconn
        .CursorLocation = adUseClient
        'The next line is where it fails if locked out.
        .Open connString
        .CommandTimeout = 0
        Set rst = .Execute(strSQL)
    End With
    xlWs.Activate
    With rst
        'Populate field headers.
        For i = 1 To .Fields.Count: xlWs.Cells(1, i) = .Fields(i - 1).Name: Next i
        'Copy data to A2.
        xlWs.Range("A2").CopyFromRecordset rst
    End With
    rst.Close
    Set rst = Nothing
    Close #FileNumber
    Exit Sub
EndMacro:
    Select Case Err.Number
        'Case -2147467259
        '    MsgBox "The database is unavailable right now.", vbOKOnly, "Optum"
        Case Else
            MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Optum"
    End Select
    On Error GoTo 0
End Sub

**June7** · 05-06-2020, 03:24 PM

Still get "variable not defined" on lProdConn.

Did you do what I suggested for debugging?

If you want to provide files, follow instructions at bottom of my post.

**Euler271** · 05-06-2020, 03:40 PM

Originally Posted by June7

Still get "variable not defined" on lProdConn.

Did you do what I suggested for debugging?

If you want to provide files, follow instructions at bottom of my post.

lProdConn is a global string variable.

Yes, I know which line is causing the problem. It's Open lSQLFolder & strFile For Input Access Read As #FileNumber
the second time through.

**June7** · 05-06-2020, 04:05 PM

I have to give up. Global variables are erroring because not declared. Figuring out what to fix just to get to compile is too annoying. And then I would have to figure out what values to use for these variables. Double annoying.

**Euler271** · 05-06-2020, 04:16 PM

All you have to do is add them to the variable declarations:

Dim lProdConn As String
Dim lSQLFolder As String

**June7** · 05-06-2020, 08:22 PM

Okay, that compiles. So tried to run procedure and immediately get "Object variable or with block variable not defined" on the Set xlWbl line.

If you cannot provide db, I cannot help.

**orange** · 05-07-2020, 05:11 AM

Here are a few links to using Freefile.
1
2
3
Good luck.

**Gicu** · 05-07-2020, 10:29 AM

Have a look at the comments I added:

Code:

Private Sub Step1(Qname As String, Ordinal As String, CID As String) 'This calls the query and fills the worksheet.
    Dim lProdConn As String
    Dim lSQLFolder As String
    
    Dim connString As String
    Dim strSQL As String
    Dim ADOconn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim xlApp As Excel.Application
    Dim xlWb1 As Excel.Workbook
    Dim xlWb3 As Excel.Workbook
    Dim xlWs As Excel.Worksheet
    Dim varReturn As Variant
    Dim adoRS As New ADODB.Recordset
    Dim i As Integer
    Dim strFile As String
    'This gets the query text.
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim WholeParagraph As String
    Dim FileNumber As Integer
    
 'vlad no Excell app initialized
    Set xlApp = GetObject("Excel.Application")
          If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
 'vlad
 
    Select Case Ordinal
        Case "First"
            Set xlWb1 = xlApp.Workbooks.Add
            Set xlWs = xlWb1.ActiveSheet
            FileNumber = FreeFile
        Case "Second"
            Set xlWb3 = xlApp.Workbooks.Add
            Set xlWs = xlWb3.ActiveSheet
            FileNumber = FreeFile
    End Select
    
    adoRS.Open lProdConn
    adoRS.MoveFirst
    While Not adoRS.EOF
        connString = connString & adoRS.Fields(0).Value & " = '" & adoRS.Fields(1).Value & "';"
        adoRS.MoveNext
    Wend
    adoRS.Close
    Set adoRS = Nothing
    varReturn = SysCmd(acSysCmdSetStatus, "Retrieving data...")
    DoEvents
    strFile = Dir(lSQLFolder & Qname)   'vlad does lSQLFolder end in \?
    strSQL = ""
    On Error GoTo EndMacro
    
    Open lSQLFolder & strFile For Input Access Read As #FileNumber 'vlad you concatenate the folder again:  Open lSQLFolder & Dir(lSQLFolder & Qname)

    While Not EOF(FileNumber)
        Line Input #FileNumber, WholeLine
        If Right(WholeLine, 1) <> "~" Then WholeLine = WholeLine & " " & "~"
        Pos = 1
        NextPos = InStr(Pos, WholeLine, "~")
        WholeParagraph = WholeParagraph + Mid(WholeLine, 1, NextPos - 1)
        While NextPos >= 1
            Pos = NextPos + 1
            NextPos = InStr(Pos, WholeLine, "~")
        Wend
    Wend
    strSQL = WholeParagraph 'end result of this block of code - a copy of the SQL from the .sql file itself
    strSQL = Replace(strSQL, "strParam1", CID)
    Set ADOconn = New ADODB.Connection
    With ADOconn
        .CursorLocation = adUseClient
        'The next line is where it fails if locked out.
        .Open connString
        .CommandTimeout = 0
        Set rst = .Execute(strSQL)
    End With
    xlWs.Activate
    With rst
        'Populate field headers.
        For i = 1 To .Fields.Count: xlWs.Cells(1, i) = .Fields(i - 1).Name: Next i
        'Copy data to A2.
        xlWs.Range("A2").CopyFromRecordset rst
    End With
    rst.Close
    Set rst = Nothing
    Close #FileNumber
    Exit Sub
EndMacro:
    Select Case Err.Number
        'Case -2147467259
        '    MsgBox "The database is unavailable right now.", vbOKOnly, "Optum"
        Case Else
            MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Optum"
    End Select
    On Error GoTo 0
End Sub

**accesstos** · 05-07-2020, 02:16 PM

Some annotations by me:

1. There is no difference of "First" and "Second" cases.
Both doing the same things with a different workbook variables.
I thing that that could be enough:

Code:

Set xlWs = xlApp.Workbooks.Add.ActiveSheet

2. Note that the method Dir(lSQLFolder & Qname) may return an empty string.
So, when you try to open a file with the directory as file name, you get the error 52 (Bad file name or number).
I suggest:

Code:

strFile = Dir(lSQLFolder & Qname)
If Len(strFile)>0 Then
    On Error GoTo EndMacro
    strSQL = ""
    FileNumber = FreeFile
    Open lSQLFolder & strFile For Input Access Read As #FileNumber
    'bla bla...
    'bla bla...

3. In case of error, the code jumps to the EndMacro label and the object rst and FileNumber stays open and in memory.
Maybe in this case you get the error 55 (file already open).
Also, even in normal conditions, all Excel objects stays in memory.
I suggest:

Code:

    [...]
ExitMacro:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Set xlWs = Nothing
    Close #FileNumber
    Exit Sub
EndMacro:
    Select Case Err.Number
        'Case -2147467259
        '    MsgBox "The database is unavailable right now.", vbOKOnly, "Optum"
        Case Else
            MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description, vbOKOnly, "Optum"
    End Select
    Resume ExitMacro
End Sub

4. Does this loop looks for the last "~" in WholeLine?

Code:

While NextPos >= 1
    Pos = NextPos + 1
    NextPos = InStr(Pos, WholeLine, "~")
Wend

This line does the same:

Code:

NextPos = InStrRev(WholeLine, "~")

Cheers,
John

Trying to use Freefile function

Thread Tools

Trying to use Freefile function

Similar Threads

Convert Private Function to Public Function

Function required for access similar to sumif function of excel

Help with building a function to accept more that one parameter into a function.

Function to load reference library - Not seeing something in function

SUM function produces Error from calculated function

Posting Permissions