Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Need to Summaries Query Resault

Posted on 2004-08-05
2
Medium Priority
?
221 Views
Last Modified: 2010-05-02
I have a app which queries a MS Sql Table which returns me Phone nbr Prefixes,Start and End Nbrs
The field is called prefix ,start,end and has data like

Prefix                  Start                                End
===================================
213232            2132320000                    2132329999
213233            2132330000                    2132339999
213234            2132340000                    2132349999
213235            2132350000                    2132359999
213238            2132380000                    2132389999
213239            2132390000                    2132399999
213400            2134000000                    2134009999

to save space in my other apps i need to be able to get to be able to find all continues blocks and then summaries them like this

213232_235     2132320000                    2132359999
213238_239     2132380000                    2132399999
213400            2134000000                    2134009999

Any Idea to to tis programaticly ??
0
Comment
Question by:AlexPonnath
[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 Comments
 
LVL 18

Accepted Solution

by:
JR2003 earned 1000 total points
ID: 11726423
I've not tested it but it should give you the general idea:

Private Function MainProcessing()

Dim sSaveStart As String
Dim sSaveEnd As String
Dim sSavePrefix As String
Dim sCurrEnd As String
Dim sCurrPrefix As String
Dim sCurrPrefix As String
Dim sFormattedPrefix As String
Dim MySet As ADODB.Recordset

'*** Put Code to open Your recordset here ***

With MySet
    If Not .EOF Then 'Initialise fields
        sSaveStart = .Fields("Start").Value
        sSaveEnd = .Fields("End").Value
        sSavePrefix = .Fields("Prefix").Value
        sPrevStart = .Fields("Start").Value
        sPrevEnd = .Fields("End").Value
        sPrevPrefix = .Fields("Prefix").Value
        While Not .EOF
            sCurrStart = .Fields("Start").Value
            sCurrEnd = .Fields("End").Value
            sCurrPrefix = .Fields("Prefix").Value
            If (sSaveStart <> .Fields("Start").Value) Or (sSaveEnd <> .Fields("End").Value) Then
                'Call the function to write the record to the output
                WriteDetails sSavePrefix, sLastPrefix, sPrevStart, sPrevEnd
                sSaveStart = .Fields("Start").Value
                sSaveEnd = .Fields("End").Value
                sSavePrefix = .Fields("Prefix").Value
            End If
            sPrevStart = .Fields("Start").Value
            sPrevEnd = .Fields("End").Value
            sPrevPrefix = .Fields("Prefix").Value
            .MoveNext
        Wend
        'Write the last record
        WriteDetails sSavePrefix, sLastPrefix, sPrevStart, sPrevEnd
    End If
    .Close
End With
End Function


Private Function WriteDetails(sSavePrefix As String, sLastPrefix As String, _
                              sStart As String, sEnd As String)

If sSavePrefix = sLastPrefix Then
    '*** Put your write statement here with two prefixes ***
    'e.g. Write the sSaveStart sSavePrefix & "_" &  sLastPrefix & "  " & sStart  & "  " & sEnd
Else
    '*** Put your write statement here with just one prefix ***
    'e.g. Write the sSaveStart sSavePrefix & "         " & sStart  & "  " & sEnd
End If
   
End Function
0
 

Author Comment

by:AlexPonnath
ID: 11731704
Thanks for trying but the code does not work, after trying forth and back i found a way to make this work...

Private Sub cmdLergScript_Click()
Dim rs As New ADODB.Recordset       ' To run Selcet queries
Dim strSQL As String
Dim s As String
Dim intStart As Double
Dim intEnd As Double
Dim intNbr As Double
Dim intcontinousFlag As Byte
Dim rsCount As Integer


strSQL = Trim(Me.txtSqlQuery)

rs.Open strSQL, cn2

rsCount = rs.RecordCount

Dim oFSO As New FileSystemObject ' to write in error log
Dim oFSTR As Scripting.TextStream ' making stream to access FSO

    oFSO.CreateTextFile "errorlog.txt"
   
    Set oFSTR = oFSO.CreateTextFile("C:" & "\lergScript.txt", ForAppending)  ' opening the file
    For i = 1 To rs.RecordCount
   
    If i <> 1 Then
    'This part of the script handles the checking if this is a continues block
    If Trim(rs("prefix")) = intEnd + 1 Then
    'the block is continues

    intEnd = Trim(rs("prefix"))
    Else
    'the block is not continues
    If intEnd <> intStart Then
   
   
 
    'we still need to write the prev Range
    s = "createRouteList " & "R_" & Trim(intStart) & "_" & Trim(Right(intEnd, 3)) & " " & Trim(intStart) & "0000" & " " & Trim(intEnd) & "9999"
    oFSTR.WriteLine s
    ' This will also Create the Route
    s = "addRoute " & "R_" & Trim(intStart) & "_" & Trim(Right(intEnd, 3)) & " " & """" & "2939-Paetec-LAX" & """"
    oFSTR.WriteLine s
   
    intEnd = Trim(rs("prefix"))
    intStart = Trim(rs("prefix"))
   
    Else
   
   
    s = "createRouteList " & "R_" & Trim(intStart) & " " & Trim(intStart) & "0000" & " " & Trim(intEnd) & "9999"
    oFSTR.WriteLine s
   
    ' This will also Create the Route
    s = "addRoute " & "R_" & Trim(intStart) & " " & """" & "2939-Paetec-LAX" & """"
    oFSTR.WriteLine s
   
    intEnd = Trim(rs("prefix"))
    intStart = Trim(rs("prefix"))
   
    End If
   
    End If
   
    Else
    ' This is the First Record
    intStart = Trim(rs("prefix"))
    intEnd = Trim(rs("prefix"))
   
    End If
   
    rs.MoveNext
    Next i
   
    ' This part processes the Last record..
    If i = rsCount + 1 Then
    If intEnd <> intStart Then
   
     
    'we still need to write the prev Range
    s = "createRouteList " & "R_" & Trim(intStart) & "_" & Trim(Right(intEnd, 3)) & " " & Trim(intStart) & "0000" & " " & Trim(intEnd) & "9999"
    oFSTR.WriteLine s
    ' This will also Create the Route
    s = "addRoute " & "R_" & Trim(intStart) & "_" & Trim(Right(intEnd, 3)) & " " & """" & "2939-Paetec-LAX" & """"
    oFSTR.WriteLine s

   
    Else
   
   
    s = "createRouteList " & "R_" & Trim(intStart) & " " & Trim(intStart) & "0000" & " " & Trim(intEnd) & "9999"
    oFSTR.WriteLine s
   
    ' This will also Create the Route
    s = "addRoute " & "R_" & Trim(intStart) & " " & """" & "2939-Paetec-LAX" & """"
    oFSTR.WriteLine s
   
   
   
    End If
    End If
    oFSTR.Close ' closing file

End Sub
0

Featured Post

Independent Software Vendors: 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

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

636 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