Solved

Need to Summaries Query Resault

Posted on 2004-08-05
2
176 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
2 Comments
 
LVL 18

Accepted Solution

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

920 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now