Solved

Need to Summaries Query Resault

Posted on 2004-08-05
2
169 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
Comment Utility
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
Comment Utility
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
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.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

762 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

10 Experts available now in Live!

Get 1:1 Help Now