Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

excel vba out of memory

Posted on 2015-01-16
3
Medium Priority
?
292 Views
Last Modified: 2015-01-16
I am running some vba that connects to sql server and pulls back records and then inserts it into multiple tabs.   The code parses out different queries based on where it finds a ";" in the text file.   The issue I am having is that on ones that it pulls back large amounts of data, I get an out of memory error.  The data still returns, so it is just a message.  


Sub ExecuteSqlScript(FilePath As String)

    Dim Script As String
    Dim FileNumber As Integer
    Dim Delimiter As String
    Dim aSubscript() As String
    Dim Subscript As String
    Dim i As Long
    Dim comm As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim dbConnectStr As String
    Dim StrSheet0 As String
    Dim strRange0 As String
    Dim StrSheet1 As String
    Dim strRange1 As String
    Dim StrSheet2 As String
    Dim strRange2 As String
    Dim StrSheet3 As String
    Dim strRange3 As String
    Dim StrSheet4 As String
    Dim strRange4 As String
    Dim StrSheet5 As String
    Dim strRange5 As String
    Dim StrSheet6 As String
    Dim strRange6 As String


    StrSheet0 = ThisWorkbook.Worksheets("Control").Range("C21").Value
    strRange0 = ThisWorkbook.Worksheets("Control").Range("D21").Value
    StrSheet1 = ThisWorkbook.Worksheets("Control").Range("C22").Value
    strRange1 = ThisWorkbook.Worksheets("Control").Range("D22").Value
    StrSheet2 = ThisWorkbook.Worksheets("Control").Range("C23").Value
    strRange2 = ThisWorkbook.Worksheets("Control").Range("D23").Value
    StrSheet3 = ThisWorkbook.Worksheets("Control").Range("C24").Value
    strRange3 = ThisWorkbook.Worksheets("Control").Range("D24").Value
    StrSheet4 = ThisWorkbook.Worksheets("Control").Range("C25").Value
    strRange4 = ThisWorkbook.Worksheets("Control").Range("D25").Value
    StrSheet5 = ThisWorkbook.Worksheets("Control").Range("C26").Value
    strRange5 = ThisWorkbook.Worksheets("Control").Range("D26").Value
    StrSheet6 = ThisWorkbook.Worksheets("Control").Range("C27").Value
    strRange6 = ThisWorkbook.Worksheets("Control").Range("D27").Value


    Application.CutCopyMode = False

    Set comm.ActiveConnection = cn
    rs.ActiveConnection = cn

    Delimiter = ";"
    FileNumber = FreeFile
    Script = String(FileLen(FilePath), vbNullChar)

    ' Grab the scripts inside the file
    Open FilePath For Binary As #FileNumber
    Get #FileNumber, , Script
    Close #FileNumber


    ' Put the scripts into an array
    aSubscript = Split(Script, Delimiter)

    ' Run each script in the array
    For i = 0 To UBound(aSubscript) - 1
        aSubscript(i) = Trim(aSubscript(i))
        Subscript = aSubscript(i)
        ' Debug.Print Subscript
        comm.CommandText = Subscript
        comm.CommandTimeout = 0
        rs.Open comm

        If i = 0 Then
            Sheets(StrSheet0).Select
            Range("A2:R1048575").Select
            Selection.ClearContents

            Sheets(StrSheet0).Range(strRange0).CopyFromRecordset rs
            FormulaFill
        Else    'Nothing
        End If
       
        If i = 1 Then
            Sheets(StrSheet1).Select
            Range("A6:B1000000").Select
            Selection.ClearContents

            Sheets(StrSheet1).Range(strRange1).CopyFromRecordset rs
            FormulaFill
        Else    'Nothing
        End If
        
        If i = 2 Then
            Sheets(StrSheet2).Select
            Range("A2:L1048575").Select
            Selection.ClearContents

            Sheets(StrSheet2).Range(strRange2).CopyFromRecordset rs
        Else    'Nothing
        End If
        Application.CutCopyMode = False
        If i = 3 Then
            Sheets(StrSheet3).Select
            Range("C28:F32").Select
            Selection.ClearContents

            Sheets(StrSheet3).Range(strRange3).CopyFromRecordset rs
        Else    'Nothing
        End If
       
        If i = 4 Then
            Sheets(StrSheet4).Select
            Range("A2:D1048575").Select
            Selection.ClearContents

            Sheets(StrSheet4).Range(strRange4).CopyFromRecordset rs
        Else    'Nothing
        End If
        
        If i = 5 Then
            Sheets(StrSheet5).Select
            Range("A2:E1048575").Select
            Selection.ClearContents

            Sheets(StrSheet5).Range(strRange5).CopyFromRecordset rs
        Else    'Nothing
        End If
        
        If i = 6 Then
            Sheets(StrSheet6).Select
            Range("A2:D1048575").Select
            Selection.ClearContents

            Sheets(StrSheet6).Range(strRange6).CopyFromRecordset rs
        Else    'Nothing
        End If
        
        rs.Close
        Set rs = Nothing
   

    Next i

    Application.CutCopyMode = False

   

    

End Sub

Open in new window

0
Comment
Question by:montrof
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 46

Accepted Solution

by:
aikimark earned 2000 total points
ID: 40554256
This will give you some memory relief
    ' Put the scripts into an array
    aSubscript = Split(Script, Delimiter)
    Script = vbNullString

Open in new window

0
 
LVL 1

Author Closing Comment

by:montrof
ID: 40554259
Thank you so much
0
 
LVL 46

Expert Comment

by:aikimark
ID: 40554286
While I was looking at the code, I simplified it.
Sub ExecuteSqlScript(FilePath As String)

    Dim Script As String
    Dim FileNumber As Integer
    Dim Delimiter As String
    Dim aSubscript() As String
    Dim Subscript As String
    Dim i As Long
    Dim comm As New ADODB.Command
    Dim rs As New ADODB.Recordset
    Dim dbConnectStr As String
    Dim StrSheet0 As String
    Dim strRange0 As String
    Dim StrSheet1 As String
    Dim strRange1 As String
    Dim StrSheet2 As String
    Dim strRange2 As String
    Dim StrSheet3 As String
    Dim strRange3 As String
    Dim StrSheet4 As String
    Dim strRange4 As String
    Dim StrSheet5 As String
    Dim strRange5 As String
    Dim StrSheet6 As String
    Dim strRange6 As String
    Dim wks As Worksheet

    StrSheet0 = ThisWorkbook.Worksheets("Control").Range("C21").Value
    strRange0 = ThisWorkbook.Worksheets("Control").Range("D21").Value
    StrSheet1 = ThisWorkbook.Worksheets("Control").Range("C22").Value
    strRange1 = ThisWorkbook.Worksheets("Control").Range("D22").Value
    StrSheet2 = ThisWorkbook.Worksheets("Control").Range("C23").Value
    strRange2 = ThisWorkbook.Worksheets("Control").Range("D23").Value
    StrSheet3 = ThisWorkbook.Worksheets("Control").Range("C24").Value
    strRange3 = ThisWorkbook.Worksheets("Control").Range("D24").Value
    StrSheet4 = ThisWorkbook.Worksheets("Control").Range("C25").Value
    strRange4 = ThisWorkbook.Worksheets("Control").Range("D25").Value
    StrSheet5 = ThisWorkbook.Worksheets("Control").Range("C26").Value
    strRange5 = ThisWorkbook.Worksheets("Control").Range("D26").Value
    StrSheet6 = ThisWorkbook.Worksheets("Control").Range("C27").Value
    strRange6 = ThisWorkbook.Worksheets("Control").Range("D27").Value

    Application.ScreenUpdating = False
    Application.CutCopyMode = False

    Set comm.ActiveConnection = cn
    rs.ActiveConnection = cn

    Delimiter = ";"
    FileNumber = FreeFile
    Script = String(FileLen(FilePath), vbNullChar)

    ' Grab the scripts inside the file
    Open FilePath For Binary As #FileNumber
    Get #FileNumber, , Script
    Close #FileNumber


    ' Put the scripts into an array
    aSubscript = Split(Script, Delimiter)
    Script = vbNullString
    
    ' Run each script in the array
    For i = 0 To UBound(aSubscript) - 1
        aSubscript(i) = Trim(aSubscript(i))
        Subscript = aSubscript(i)
        ' Debug.Print Subscript
        comm.CommandText = Subscript
        comm.CommandTimeout = 0
        rs.Open comm

        If i = 0 Then
            Set wks = Sheets(StrSheet0)
            wks.Range("A2:R1048575").ClearContents

            wks.Range(strRange0).CopyFromRecordset rs
            FormulaFill
        End If
       
        If i = 1 Then
            Set wks = Sheets(StrSheet1)
            wks.Range("A6:B1000000").ClearContents

            wks.Range(strRange1).CopyFromRecordset rs
            FormulaFill
        End If
        
        If i = 2 Then
            Set wks = Sheets(StrSheet2)
            wks.Range("A2:L1048575").ClearContents

            wks.Range(strRange2).CopyFromRecordset rs
        End If
        Application.CutCopyMode = False
        If i = 3 Then
            Set wks = Sheets(StrSheet3)
            wks.Range("C28:F32").ClearContents

            wks.Range(strRange3).CopyFromRecordset rs
        End If
       
        If i = 4 Then
            Set wks = Sheets(StrSheet4)
            wks.Range("A2:D1048575").ClearContents

            wks.Range(strRange4).CopyFromRecordset rs
        End If
        
        If i = 5 Then
            Set wks = Sheets(StrSheet5)
            wks.Range("A2:E1048575").ClearContents

            wks.Range(strRange5).CopyFromRecordset rs
        End If
        
        If i = 6 Then
            Set wks = Sheets(StrSheet6)
            wks.Range("A2:D1048575").ClearContents

            wks.Range(strRange6).CopyFromRecordset rs
        End If
        
        rs.Close
        Set rs = Nothing

    Next i

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

Open in new window


If you posted the workbook, I might be able to simplify it further.  I suspect the ranges you are clearing are the same ranges you are populating.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

715 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question