简体   繁体   中英

Run time error '6' OverFlow (Excel VBA)

I am having this error, i have thousands of csv files to be loaded, it can only load about hundred files per time. Can anyone advise me where is the error?

Option Explicit

Function ImportData()

    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook   As Workbook
    Dim rngSourceRange1  As Range
    Dim rngSourceRange2 As Range
    Dim rngDestination1  As Range
    Dim rngDestination2  As Range
    Dim intColumnCount  As Integer

    Set wkbCrntWorkBook = ActiveWorkbook

    Dim SelectedItemNumber As Integer

    Dim YesOrNoAnswerToMessageBox As String

    Dim Highest As Double
    Highest = 0

    Dim counter As Integer
    Dim h1 As Integer
    Dim h2 As Integer

    h1 = 1
    h2 = 7

    Do

    SelectedItemNumber = SelectedItemNumber + 1

    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Command Separated Values", "*.csv", 1
        '.Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 2
        '.Filters.Add "Excel 2002-03", "*.xls", 3
        .AllowMultiSelect = True
        .Show

    For SelectedItemNumber = 1 To .SelectedItems.Count

        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(SelectedItemNumber)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange1 = ActiveCell.Offset(1, 0)
            Set rngSourceRange2 = ActiveCell.Offset(1, 6)

            For counter = 0 To 300

            Columns("H:H").NumberFormat = "0.00"

            'Highest = Application.WorksheetFunction.Max(Range("H1:H300"))

                If Highest <= ActiveCell.Offset(h1, h2).Value Then
                    Highest = ActiveCell.Offset(h1, h2).Value
                End If

                h1 = h1 + 1

            Next

            wkbCrntWorkBook.Activate

            Set rngDestination1 = ActiveCell.Offset(1, 0)
            Set rngDestination2 = ActiveCell.Offset(1, 1)

            ActiveCell.Offset(1, 2).Value = Highest

            For intColumnCount = 1 To rngSourceRange1.Columns.Count

                If intColumnCount = 1 Then
                    rngSourceRange1.Columns(intColumnCount).Copy rngDestination1
                Else
                    rngSourceRange1.Columns(intColumnCount).Copy rngDestination1.End(xlDown).End(xlDown).End(xlUp).Offset(1)
                End If
            Next

            For intColumnCount = 1 To rngSourceRange2.Columns.Count

                If intColumnCount = 1 Then
                    rngSourceRange2.Columns(intColumnCount).Copy rngDestination2
                Else
                    rngSourceRange2.Columns(intColumnCount).Copy rngDestination2.End(xlDown).End(xlDown).End(xlUp).Offset(1)
                End If
            Next

            ActiveCell.Offset(1, 0).Select

            wkbSourceBook.Close False
        End If

    Next SelectedItemNumber

    End With

    YesOrNoAnswerToMessageBox = MsgBox("Continue?", vbYesNo)

    Loop While YesOrNoAnswerToMessageBox = vbYes


    Set wkbCrntWorkBook = Nothing
    Set wkbSourceBook = Nothing
    Set rngSourceRange1 = Nothing
    Set rngSourceRange2 = Nothing
    Set rngDestination1 = Nothing
    Set rngDestination2 = Nothing
    YesOrNoAnswerToMessageBox = Empty
    SelectedItemNumber = Empty
    Highest = Empty
    counter = Empty
    h1 = Empty
    h2 = Empty
    intColumnCount = Empty

End Function

To remove this question from the Unanswered Questions list, I'm going to answer this in "community wiki" style to avoid taking credit for other people's work.

As Tim Williams answered in the comments, part of the answer is to use Long variables instead of Integer variables to make sure that you don't exceed the allowable variable value when running through large numbers of iterations.

The other part of the answer, as made clear by the last comment from user1828786, is to scan your code for logical errors to make sure that your counter variables are being reset for each loop you make.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM