VBScript: ADODB Connection to Excel Variable Range

1
votes

I've got some working code here that I'm trying to improve with an integer to alphabet solution.

I have a massive Excel Spreadsheet that the user will address with ADODB to a specific Range based on their input (to reduce the recordset size).

So, if the input is 1 the range is A1:H51 and if the input is 2, its offset by 8 fields.

Right now, as you can see below, I'm just doing 50 If Then Statements. My question is how can I use a variable to set the range based on the input?

Or is it good enough as is? Seems complicated...

Dim SelectedSpreadsheetFromTxt
Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile("C:\ProgramData\vizrt\Trio\GolfShotSheetSpreadsheetPath.txt")
    line = file.ReadLine
    file.Close

SelectedSpreadsheetFromTxt = line

Dim Message,Flag,Name,Score,Hole,Par,Shot,NullField
Dim objConnection, objRecordSet

    set objConnection = CreateObject("ADODB.Connection")
    set objRecordSet = CreateObject("ADODB.Recordset")

    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" &_
    "Data Source=" & SelectedSpreadsheetFromTxt & ";" &_
    "Extended Properties=""Excel 12.0; HDR=Yes; IMEX=1"";"

'inputbox to ask for sheet number
Dim SheetFromInput
SheetFromInput = InputBox("What Shot Sheet?" & vbNewLine & "Enter the Number: 1,2,3,4,5, etc...","Shot Sheet")

Dim ShotRange
If SheetFromInput = 1 Then
    ShotRange = "Shot_Graphics$A1:H51" 
End If
If SheetFromInput = 2 Then
    ShotRange = "Shot_Graphics$I1:P51"
End If
If SheetFromInput = 3 Then
    ShotRange = "Shot_Graphics$Q1:X51"
End If
If SheetFromInput = 4 Then
    ShotRange = "Shot_Graphics$Y1:AF51"
End If
If SheetFromInput = 5 Then
    ShotRange = "Shot_Graphics$AG1:AN51"
End If
If SheetFromInput = 6 Then
    ShotRange = "Shot_Graphics$AO1:AV51"
End If
If SheetFromInput = 7 Then
    ShotRange = "Shot_Graphics$AW1:BD51"
End If
If SheetFromInput = 8 Then
    ShotRange = "Shot_Graphics$BE1:BL51"
End If
If SheetFromInput = 9 Then
    ShotRange = "Shot_Graphics$BM1:BT51"
End If
If SheetFromInput = 10 Then
    ShotRange = "Shot_Graphics$BU1:CB51"
End If
If SheetFromInput = 11 Then
    ShotRange = "Shot_Graphics$CC1:CJ51"
End If
If SheetFromInput = 12 Then
    ShotRange = "Shot_Graphics$CK1:CR51"
End If
If SheetFromInput = 13 Then
    ShotRange = "Shot_Graphics$CS1:CZ51"
End If
If SheetFromInput = 14 Then
    ShotRange = "Shot_Graphics$DA1:DH51"
End If
If SheetFromInput = 15 Then
    ShotRange = "Shot_Graphics$DI1:DP51"
End If
If SheetFromInput = 16 Then
    ShotRange = "Shot_Graphics$DQ1:DX51"
End If
If SheetFromInput = 17 Then
    ShotRange = "Shot_Graphics$DY1:EF51"
End If
If SheetFromInput = 18 Then
    ShotRange = "Shot_Graphics$EG1:EN51"
End If
If SheetFromInput = 19 Then
    ShotRange = "Shot_Graphics$EO1:EV51"
End If
If SheetFromInput = 20 Then
    ShotRange = "Shot_Graphics$EW1:FD51"
End If
If SheetFromInput = 21 Then
    ShotRange = "Shot_Graphics$FE1:FL51"
End If
If SheetFromInput = 22 Then
    ShotRange = "Shot_Graphics$FM1:FT51"
End If
If SheetFromInput = 23 Then
    ShotRange = "Shot_Graphics$FU1:GB51"
End If
If SheetFromInput = 24 Then
    ShotRange = "Shot_Graphics$GC1:GJ51"
End If
If SheetFromInput = 25 Then
    ShotRange = "Shot_Graphics$GK1:GR51"
End If
If SheetFromInput = 26 Then
    ShotRange = "Shot_Graphics$GS1:GZ51"
End If
If SheetFromInput = 27 Then
    ShotRange = "Shot_Graphics$HA1:HH51"
End If
If SheetFromInput = 28 Then
    ShotRange = "Shot_Graphics$HI1:HP51"
End If
If SheetFromInput = 29 Then
    ShotRange = "Shot_Graphics$HQ1:HX51"
End If
If SheetFromInput = 30 Then
    ShotRange = "Shot_Graphics$HY1:IF51"
End If
If SheetFromInput = 31 Then
    ShotRange = "Shot_Graphics$IG1:IN51"
End If
If SheetFromInput = 32 Then
    ShotRange = "Shot_Graphics$IO1:IV51"
End If
If SheetFromInput = 33 Then
    ShotRange = "Shot_Graphics$IW1:JD51"
End If
If SheetFromInput = 34 Then
    ShotRange = "Shot_Graphics$JE1:JL51"
End If
If SheetFromInput = 35 Then
    ShotRange = "Shot_Graphics$JM1:JT51"
End If
If SheetFromInput = 36 Then
    ShotRange = "Shot_Graphics$JU1:KB51"
End If
If SheetFromInput = 37 Then
    ShotRange = "Shot_Graphics$KC1:KJ51"
End If
If SheetFromInput = 38 Then
    ShotRange = "Shot_Graphics$KK1:KR51"
End If
If SheetFromInput = 39 Then
    ShotRange = "Shot_Graphics$KS1:KZ51"
End If
If SheetFromInput = 40 Then
    ShotRange = "Shot_Graphics$LA1:LH51"
End If
If SheetFromInput = 41 Then
    ShotRange = "Shot_Graphics$LI1:LP51"
End If
If SheetFromInput = 42 Then
    ShotRange = "Shot_Graphics$LQ1:LX51"
End If
If SheetFromInput = 43 Then
    ShotRange = "Shot_Graphics$LY1:MF51"
End If
If SheetFromInput = 44 Then
    ShotRange = "Shot_Graphics$MG1:MN51"
End If
If SheetFromInput = 45 Then
    ShotRange = "Shot_Graphics$MO1:MV51"
End If
If SheetFromInput = 46 Then
    ShotRange = "Shot_Graphics$MW1:ND51"
End If
If SheetFromInput = 47 Then
    ShotRange = "Shot_Graphics$NE1:NL51"
End If
If SheetFromInput = 48 Then
    ShotRange = "Shot_Graphics$NM1:NT51"
End If
If SheetFromInput = 49 Then
    ShotRange = "Shot_Graphics$NU1:OB51"
End If
If SheetFromInput = 50 Then
    ShotRange = "Shot_Graphics$OC1:OJ51"
End If

        objRecordSet.Open "SELECT * FROM [" & ShotRange & "]", objConnection

            MessageColumn = 0
            FlagColumn = 1
            NameColumn = 2
            ScoreColumn = 3
            HoleColumn = 4
            ParColumn = 5
            ShotColumn = 6
            NullFieldColumn = 7

    Do Until objRecordSet.EOF       
            Message = objRecordSet.Fields.Item(0)
            Flag = objRecordSet.Fields.Item(1)
            Name = objRecordSet.Fields.Item(2)
            Score = objRecordSet.Fields.Item(3)
            Hole = objRecordSet.Fields.Item(4)
            Par = objRecordSet.Fields.Item(5)
            Shot = objRecordSet.Fields.Item(6)
            NullField = objRecordSet.Fields.Item(7)

                TrioCmd("page:read_template SHOT_STROKEPLAY-FULL_GOLF")
                TrioCmd("page:set_property 0100 " & Flag)
                TrioCmd("page:set_property 0102 " & NullField)
                TrioCmd("page:set_property 0140 " & Name)
                TrioCmd("page:set_property 0150 " & Score)
                TrioCmd("page:set_property 0210 " & Hole)
                TrioCmd("page:set_property 0220 " & Par)
                TrioCmd("page:set_property 0230 " & Shot)
                TrioCmd("page:set_property 0320 " & NullField)
                TrioCmd("page:set_property 0330 " & NullField)
                TrioCmd("page:set_property 0410 " & NullField)
                TrioCmd("page:set_property 0510 " & NullField)
                TrioCmd("page:saveas " & Message)
    objRecordSet.MoveNext
    Loop

    objRecordSet.Close
    set objRecordSet = Nothing

    objConnection.Close
    set objConnection = Nothing
1
excelvbscriptadodbvba
If “Thanks in advance” is at the start of a question, that tells me you probably haven’t read How to Ask or understand what the purpose of Stack Overflow is. Sorry if this sounds harsh, but people need to understand that SO isn’t a help forum, which makes questions that begin “Thanks in advance” too personally to belong here. You could try de-personalising the question with an edit and just concentrate on the problem and avoid fluff in a way that you think will help others with a similar issue. - user692942
Ok here goes... - chris
Appreciate the attitude @chris, good luck. Will check in again. - user692942

1 Answers

2
votes

If you opened the workbook then you could have used the offset function of the range object. Then you could do something like

baseRange = Range("A1:H51")

If SheetFromInput > 1 Then
    ShotRange = baseRange.Offset(0, (SheetFromInput - 1) * 8)
Else
    ShotRange = baseRange
End If

but since you are doing a query then you need to create the function to get the alpha characters. You do this by using the ascii values for A-Z:65-90. Dividing by 26 and starting at 64 since 1 = A and 64+1 is the aschii value for A.

*Note that this is not fully tested and could probably be done more efficiently

If SheetFromInput > 1 Then
    ShotRange = "Shot_Graphics$" & getRangeAlpha((SheetFromInput - 1) * 8 + 1) & "1:" & getRangeAlpha((SheetFromInput - 1) * 8 + 8) & "51"
Else
    ShotRange = "Shot_Graphics$" & getRangeAlpha(1) & "1:" & getRangeAlpha(8) & "51"
End If




Function getRangeAlpha(val)
'Ascii 65-90 A-Z
'divide by 26
Dim numLetters
Dim numRemainingLetters
Dim letterRange

numLetters = val \ 26
numRemainingLetters = val Mod 26
'check to see if we are at ZZ (702)
'we do this as 27 returns AA in this function.  This is the only known issue.
If numLetters = 27 Then
    getRangeAlpha = "ZZ"
    Exit Function
End If
'check to see if we have three letters
If numLetters > 26 Then
    Dim numThirdLetter
    'get the value for the third letter (first in series)
    numThirdLetter = numLetters \ 26
    'set the next letter to the remaining value
    numLetters = numLetters Mod 26
    'add the letter
    letterRange = Chr(64 + numThirdLetter)
End If

If numLetters > 0 Then
    letterRange = letterRange + Chr(64 + numLetters)
End If
If numRemainingLetters > 0 Then
    letterRange = letterRange + Chr(64 + numRemainingLetters)
End If

getRangeAlpha = letterRange
End Function