Solved

excel vba out of memory

Posted on 2015-01-16
3
275 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 45

Accepted Solution

by:
aikimark earned 500 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 45

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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

734 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