Here are some macros I've written for Microsoft Excel and Visio. Since I wouldn't have been able to write these without the examples provided by many other people and put on line, I'm releasing them under the Creative Commons Attribution-Noncommercial-Share Alike 3.0 United States License.
I've only run these from Microsoft Excel 2003, so your mileage may vary. If they cause problems on your system, you can't sue me, you use them at your own risk, etc. etc. I also make no promise that they'll work for you at all. These macros are written in VBA, which is being phased out in favor of signed code.
Excel 2003 Macros
There weren't too many examples online that showed how to use VBA in conjunction with TestDirector, so here are the macros I wrote to get the information my bosses required.
These macros are designed to connect to a Mercury Interactive TestDirector database and does some heavy processing. The EmailReport macro isn't required by the UpdateReport macro, but it can be reused for other things fairly easily.
EmailReport
This subroutine is used to create an Outlook email message that sends an attachment to the listed people. You can remove the filepath parameter and the Attachments.Add line to create a generic email subroutine.
Sub EmailReport(filepath)
sendTO = "String_for_email_address_1;String_for_email_address_2;"
sendCC = "String_for_email_address_1;String_for_email_address_2;" 'optional
sendBCC = "String_for_email_address" 'optional
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.To = sendTO
myItem.CC = sendCC
myItem.BCC = sendBCC
myItem.Subject = "String that sets the subject."
myItem.body = "Message text." & vbCrLf & "More message text." & vbCrLf
myItem.Attachments.Add filepath 'optional. comment out if you don't need it.
On Error Resume Next
myItem.send
If Err.Number <> 0 Then
MsgBox ("Message NOT sent.")
End If
On Error GoTo 0
Set myOlApp = Nothing
Set myItem = Nothing
End Sub
UpdateDefectCount
This function is needed by UpdateReport. It finds the number of defects that match the criteria specified in the parameters passed when calling the function.
The parameters are as follows:
connection = The name of the TestDirector TDConnection object.
defectType = The status of the defects the function should return (fixed, open, new, etc.).
defectDetectDate = The date the defects were discovered (as listed in TestDirector).
priLevel = The priority level of the defects (A, B, C, etc.).
Function UpdateDefectCount(connection, defectType, defectDetectDate, priLevel)
Dim bugFact As BugFactory
Set bugFact = connection.BugFactory
Dim fltr As TDFilter
Set fltr = bugFact.Filter
fltr.Filter("BG_STATUS") = defectType
fltr.Filter("BG_DETECTED_BY") = "client"
If defectDetectDate <> "" Then
fltr.Filter("BG_DETECTION_DATE") = defectDetectDate
Else
fltr.Filter("BG_DETECTION_DATE") = ">=MM/DD/YYYY" 'after or equal to some date
End If
If priLevel <> "" Then
fltr.Filter("BG_PRIORITY") = priLevel
Else
fltr.Filter("BG_PRIORITY") = "*"
End If
Dim defectCount As Long
defectCount = 0
For Each Bug In fltr.NewList
defectCount = defectCount + 1
Next Bug
UpdateDefectCount = defectCount 'return the # of bugs to appropriate cell.
End Function
FindLastRunDate
This function will look through the provided worksheet and find the date the UpdateReport macro was run. This macro is tied to the Summary worksheet in the daily defect tracking Excel workbook. You should probably modify it to suit your needs.
Function FindLastRunDate(sheet)
Dim ws As Worksheet
Set ws = sheet
Dim colrange As Range
Set colrange = sheet.Columns("E")
Dim rowcounter As Long
rowcounter = 0
For Each c In colrange.Rows
If c.Value <> "" Then
rowcounter = rowcounter + 1
End If
Next
Dim lastDate As Date
lastDate = sheet.Cells(rowcounter, "E").Value
FindLastRunDate = lastDate
End Function
UpdateReport
This macro was developed to solve a very specific need on one of my contracts. I've stripped out a lot of the identifying features of the macro. Skilled VBA/Office programmers will look at it and probably find a lot of areas that could be written more efficiently. If you'd like to comment about the quality of the code you can, but please remember these things:
- The code did everything my boss wanted it to do.
- In the six months I ran the macro, it ran without problems every workday.
- The macro took a process that used to take two hours a day and reduced it to three minutes a day.
That being said, I'm sure there has to be a way to get the macro to run more efficiently. There are a lot of nested select elements, and the TestDirector buglist/history list puts quite a demand on the processor.
Sub UpdateReport()
On Error GoTo CheckError
'connect to TestDirector
Dim server, domainname, domainpassword, username, password As String
server = "http://SERVERNAME/tdbin" 'for some reason putting a trailing slash on this causes it to fail.
domainname = "DEFAULT"
domainpassword = ""
username = "Your TestDirector User Name"
password = "Your TestDirector Password"
Dim tdc As New TDConnection
If tdc.Connected Then 'clear out any old connections before starting a new connection.
tdc.ReleaseConnection
End If
tdc.InitConnection server, domainname
'connect to correct project
tdc.ConnectProject "Project name as string", username
Application.ScreenUpdating = False
Application.StatusBar = "Connected to TestDirector..."
'get bugs from TD
Dim bgf As BugFactory
Dim bg As Bug
Dim bgl As List
Dim bflt As TDFilter
Dim bgc, bc As Long
Dim bugstr As String
Dim his As History
Dim hisRec As HistoryRecord
Dim hisList As List
Dim startdate As Date
Dim numDays As Long
Dim wkdays As Long
Dim myrange As Range
Dim nr, rc As Long
Dim wsDactVol As Worksheet
Dim wsDActSumm As Worksheet
Dim wsSummary As Worksheet
Dim wsDetailedHistory As New Worksheet
Dim wsStatSheet As New Worksheet
Dim detHistName As String
Dim genStatName As String
Dim consultantcount, clientcount, csnf, actCnt, oAc, oBc, oCc, oDc, oEc, oFc, oGc, cAc, cBc, cCc, cDc, cEc, cFc, cGc, _
nfAc, nfBc, nfCc, nfDc, nfEc, nfFc, nfGc, fAc, fBc, fCc, fDc, fEc, fFc, fGc, rjAc, rjBc, rjCc, rjDc, rjEc, rjFc, rjGc, _
rtAc, rtBc, rtCc, rtDc, rtEc, rtFc, rtGc, oT, cT, nfT, fT, rjT, rtT, totA, totB, totC, totD, totE, totF, totG, _
cnt, onetime, twotime, threetime, fourtime, fivetime, sixtime, seventime, eighttime, ninetime, tentime, _
eleventime, twelvetime, thirteentime, fourteentime, fifteentime, sixteentime, seventeentime, eightteentime, nineteentime, twentytime As Long
Dim dateArray() As Date
Dim intI, intj As Integer
Dim dt As Date
Dim detHistRowCount As Long
Dim summLastRow As Long
Dim summNextRow As Long
Dim davLastRun As Date
Dim davLastRow As Long
Dim davNextRow As Long
Dim dasLastRow As Long
Dim dasNextRow As Long
Dim r1 As Range
startdate = #10/23/2006#
Set wsSummary = ActiveWorkbook.Worksheets("Summary")
Set wsDactVol = ActiveWorkbook.Worksheets("Daily Activity Volume")
Set wsDActSumm = ActiveWorkbook.Worksheets("Daily Activity Volume - Summary")
detHistName = "Detailed Defect History"
Worksheets.Add(after:=Worksheets("Summary")).Name = detHistName
Set wsDetailedHistory = Worksheets(detHistName)
wsDetailedHistory.Columns(3).NumberFormat = "m/d/yyyy" 'detection date
wsDetailedHistory.Columns(7).NumberFormat = "m/d/yyyy" 'date closed
wsDetailedHistory.Columns(8).NumberFormat = "m/d/yyyy h:mm:ss AM/PM" 'date status changed
genStatName = "General Statistics Info"
Worksheets.Add(after:=Worksheets(detHistName)).Name = genStatName
Set wsStatSheet = Worksheets(genStatName)
davLastRow = wsDactVol.UsedRange.Rows.Count
dasLastRow = wsDActSumm.UsedRange.Rows.Count
summLastRow = wsSummary.UsedRange.Rows.Count
summNextRow = summLastRow + 1
detHistRowCount = 1
'get only the records that were found by client after startdate
Set bgf = tdc.BugFactory
Set bflt = bgf.Filter
bflt.Filter("BG_DETECTION_DATE") = ">=" & Str(startdate)
bflt.Filter("BG_DETECTED_BY") = LCase("client")
Set bgl = bflt.NewList
bgc = 0
bgc = bgl.Count
bc = 0
davLastRun = FindLastRunDate(wsDactVol)
numDays = Date - davLastRun
wkdays = networkdays(davLastRun, Date) - 1 'NETWORKDAYS computes an extra day. Finds 3 instead of 2. Subtract 1 to fix.
ReDim dateArray(numDays) 'resize datearray to number of days to examine.
intj = 0
For intI = 0 To numDays 'put each date into date array
dt = davLastRun + intI
If Weekday(dt) > 1 Then
If Weekday(dt) < 7 Then
dateArray(intj) = dt
intj = intj + 1
End If
End If
Next
davNextRow = 0
davNextRow = davLastRow + 1
dasNextRow = 0
dasNextRow = dasLastRow + 1
consultantcount = 0
clientcount = 0
actCnt = 0
csnf = 0
oAc = 0
oBc = 0
oCc = 0
oDc = 0
oEc = 0
oFc = 0
oGc = 0
cAc = 0
cBc = 0
cCc = 0
cDc = 0
cEc = 0
cFc = 0
cGc = 0
nfAc = 0
nfBc = 0
nfCc = 0
nfDc = 0
nfEc = 0
nfFc = 0
nfGc = 0
fAc = 0
fBc = 0
fCc = 0
fDc = 0
fEc = 0
fFc = 0
fGc = 0
rjAc = 0
rjBc = 0
rjCc = 0
rjDc = 0
rjEc = 0
rjFc = 0
rjGc = 0
rtAc = 0
rtBc = 0
rtCc = 0
rtDc = 0
rtEc = 0
rtFc = 0
rtGc = 0
oT = 0
cT = 0
nfT = 0
fT = 0
rjT = 0
rtT = 0
totA = 0
totB = 0
totC = 0
totD = 0
totE = 0
totF = 0
totG = 0
cnt = 0
onetime = 0
twotime = 0
threetime = 0
fourtime = 0
fivetime = 0
sixtime = 0
seventime = 0
eighttime = 0
ninetime = 0
tentime = 0
eleventime = 0
twelvetime = 0
thirteentime = 0
fourteentime = 0
fifteentime = 0
sixteentime = 0
seventeentime = 0
eightteentime = 0
nineteentime = 0
twentytime = 0
For intI = 1 To wkdays
If wsSummary.Cells(summNextRow, 1) = "" Then
wsSummary.Cells(summNextRow, 1) = Format(dateArray(intI), "mm/dd/yyyy")
wsSummary.Cells(summNextRow, 2) = UpdateDefectCount(tdc, "*", "", "")
wsSummary.Cells(summNextRow, 3) = UpdateDefectCount(tdc, "*", "", "A*")
wsSummary.Cells(summNextRow, 4) = UpdateDefectCount(tdc, "Open", dateArray(intI), "") + UpdateDefectCount(tdc, "New", dateArray(intI), "")
wsSummary.Cells(summNextRow, 5) = UpdateDefectCount(tdc, "Open", "", "") + UpdateDefectCount(tdc, "New", "", "")
wsSummary.Cells(summNextRow, 7) = UpdateDefectCount(tdc, "Open", "", "A*") + UpdateDefectCount(tdc, "New", "", "A*")
wsSummary.Cells(summNextRow, 8) = UpdateDefectCount(tdc, "Not*", "", "")
wsSummary.Cells(summNextRow, 10) = UpdateDefectCount(tdc, "Not*", "", "A*")
wsSummary.Cells(summNextRow, 11) = UpdateDefectCount(tdc, "Fixed", "", "") + UpdateDefectCount(tdc, "Re*", "", "") 'Re* = REjected/REtest
wsSummary.Cells(summNextRow, 13) = UpdateDefectCount(tdc, "Fixed", "", "A*") + UpdateDefectCount(tdc, "Re*", "", "A*")
wsSummary.Cells(summNextRow, 14) = UpdateDefectCount(tdc, "Closed", "", "")
wsSummary.Cells(summNextRow, 16) = UpdateDefectCount(tdc, "Closed", "", "A*")
wsSummary.Cells(summNextRow, 17) = wsSummary.Cells(summNextRow, 5) + wsSummary.Cells(summNextRow, 8)
End If
'calculate deltas (change from yesterday)
wsSummary.Cells(summNextRow, 6) = wsSummary.Cells(summNextRow, 5) - wsSummary.Cells(summLastRow, 5) 'open
wsSummary.Cells(summNextRow, 9) = wsSummary.Cells(summNextRow, 8) - wsSummary.Cells(summLastRow, 8) 'not fixed
wsSummary.Cells(summNextRow, 12) = wsSummary.Cells(summNextRow, 11) - wsSummary.Cells(summLastRow, 11) 'fixed
wsSummary.Cells(summNextRow, 15) = wsSummary.Cells(summNextRow, 14) - wsSummary.Cells(summLastRow, 14) 'closed
For bc = 0 To bgc
Set hisList = bgl.Item(bc).History.NewList("")
For Each r In hisList
Application.StatusBar = "Processing Defect " & bgl.Item(bc).ID
If r.FieldName = "BG_STATUS" Then 'defect status changed, that's what we want to track.
detHistRowCount = detHistRowCount + 1
wsDetailedHistory.Cells(detHistRowCount, 1).Value = bgl.Item(bc).ID
wsDetailedHistory.Cells(detHistRowCount, 2).Value = bgl.Item(bc).Field("BG_USER_06")
wsDetailedHistory.Cells(detHistRowCount, 3).Value = bgl.Item(bc).Field("BG_DETECTION_DATE")
wsDetailedHistory.Cells(detHistRowCount, 4).Value = Left(bgl.Item(bc).Field("BG_PRIORITY"), 1)
wsDetailedHistory.Cells(detHistRowCount, 5).Value = bgl.Item(bc).summary
wsDetailedHistory.Cells(detHistRowCount, 6).Value = Left(bgl.Item(bc).Field("BG_STATUS"), 9)
wsDetailedHistory.Cells(detHistRowCount, 7).Value = bgl.Item(bc).Field("BG_CLOSING_DATE")
wsDetailedHistory.Cells(detHistRowCount, 8).Value = r.ChangeDate
If Format(r.ChangeDate, "mm/dd/yyyy") = dateArray(intI) Then 'date status changed matches date we're looking at now.
wsDactVol.Cells(davNextRow, 1).Value = bgl.Item(bc).ID
wsDactVol.Cells(davNextRow, 2).Value = bgl.Item(bc).Field("BG_USER_06")
Dim pri As String
pri = Left(bgl.Item(bc).Field("BG_PRIORITY"), 1)
Dim bstat As String
bstat = bgl.Item(bc).Field("BG_STATUS")
wsDactVol.Cells(davNextRow, 3).Value = pri
wsDactVol.Cells(davNextRow, 5).Value = Format(r.ChangeDate, "m/d/yy ss")
Select Case pri
Case "A"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 7).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oAc = oAc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 8).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cAc = cAc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 9).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfAc = nfAc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 10).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fAc = fAc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 11).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjAc = rjAc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 12).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtAc = rtAc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
End Select
Case "B"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 13).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oBc = oBc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 14).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cBc = cBc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 15).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfBc = nfBc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 16).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fBc = fBc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 17).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjBc = rjBc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 18).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtBc = rtBc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
Case "C"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 19).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oCc = oCc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 20).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cCc = cCc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 21).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfCc = nfCc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 22).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fCc = fCc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 23).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjCc = rjCc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 24).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtCc = rtCc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
Case "D"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 25).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oDc = oDc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 26).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cDc = cDc + 1
clientcount = clientcount + 1
Case "Not"
wsDactVol.Cells(davNextRow, 27).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfDc = nfDc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 28).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fDc = fDc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 29).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjDc = rjDc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 30).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtDc = rtDc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
Case "E"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 31).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oEc = oEc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 32).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cEc = cEc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 33).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfEc = nfEc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 34).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fEc = fEc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 35).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjEc = rjEc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 36).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtEc = rtEc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
Case "F"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 37).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oFc = oFc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 38).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cFc = cFc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 39).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfFc = nfFc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 40).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fFc = fFc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 41).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjFc = rjFc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 42).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtFc = rtFc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
Case "G"
Select Case Left(bstat, 3)
Case "Ope"
wsDactVol.Cells(davNextRow, 43).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Open"
oGc = oGc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Clo"
wsDactVol.Cells(davNextRow, 44).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Closed"
cGc = cGc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
Case "Not"
wsDactVol.Cells(davNextRow, 45).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Not Fixed"
nfGc = nfGc + 1
clientcount = clientcount + 1
actCnt = actCnt + 1
csnf = csnf + 1
Case "Fix"
wsDactVol.Cells(davNextRow, 46).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Fixed"
fGc = fGc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Rej"
wsDactVol.Cells(davNextRow, 47).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Rejected"
rjGc = rjGc + 1
consultantcount = consultantcount + 1
actCnt = actCnt + 1
Case "Ret"
wsDactVol.Cells(davNextRow, 48).Value = 1
wsDactVol.Cells(davNextRow, 4).Value = "Retest"
rtGc = rtGc + 1
actCnt = actCnt + 1
clientcount = clientcount + 1
End Select
End Select
davNextRow = davNextRow + 1
End If
End If
Next 'history list loop
Next 'bc (bug count loop)
wsDactVol.Cells(davNextRow, 5).Value = dateArray(intI)
wsDactVol.Rows(davNextRow).Font.Bold = True
wsDactVol.Rows(davNextRow).EntireRow.Interior.Color = RGB(204, 255, 204)
wsDactVol.Cells(davNextRow, 6).Value = actCnt
wsDactVol.Cells(davNextRow, 7).Value = oAc
wsDactVol.Cells(davNextRow, 8).Value = cAc
wsDactVol.Cells(davNextRow, 9).Value = nfAc
wsDactVol.Cells(davNextRow, 10).Value = fAc
wsDactVol.Cells(davNextRow, 11).Value = rjAc
wsDactVol.Cells(davNextRow, 12).Value = rtAc
wsDactVol.Cells(davNextRow, 13).Value = oBc
wsDactVol.Cells(davNextRow, 14).Value = cBc
wsDactVol.Cells(davNextRow, 15).Value = nfBc
wsDactVol.Cells(davNextRow, 16).Value = fBc
wsDactVol.Cells(davNextRow, 17).Value = rjBc
wsDactVol.Cells(davNextRow, 18).Value = rtBc
wsDactVol.Cells(davNextRow, 19).Value = oCc
wsDactVol.Cells(davNextRow, 20).Value = cCc
wsDactVol.Cells(davNextRow, 21).Value = nfCc
wsDactVol.Cells(davNextRow, 22).Value = fCc
wsDactVol.Cells(davNextRow, 23).Value = rjCc
wsDactVol.Cells(davNextRow, 24).Value = rtCc
wsDactVol.Cells(davNextRow, 25).Value = oDc
wsDactVol.Cells(davNextRow, 26).Value = cDc
wsDactVol.Cells(davNextRow, 27).Value = nfDc
wsDactVol.Cells(davNextRow, 28).Value = fDc
wsDactVol.Cells(davNextRow, 29).Value = rjDc
wsDactVol.Cells(davNextRow, 30).Value = rtDc
wsDactVol.Cells(davNextRow, 31).Value = oEc
wsDactVol.Cells(davNextRow, 32).Value = cEc
wsDactVol.Cells(davNextRow, 33).Value = nfEc
wsDactVol.Cells(davNextRow, 34).Value = fEc
wsDactVol.Cells(davNextRow, 35).Value = rjEc
wsDactVol.Cells(davNextRow, 36).Value = rtEc
wsDactVol.Cells(davNextRow, 37).Value = oFc
wsDactVol.Cells(davNextRow, 38).Value = cFc
wsDactVol.Cells(davNextRow, 39).Value = nfFc
wsDactVol.Cells(davNextRow, 40).Value = fFc
wsDactVol.Cells(davNextRow, 41).Value = rjFc
wsDactVol.Cells(davNextRow, 42).Value = rtFc
wsDactVol.Cells(davNextRow, 43).Value = oGc
wsDactVol.Cells(davNextRow, 44).Value = cGc
wsDactVol.Cells(davNextRow, 45).Value = nfGc
wsDactVol.Cells(davNextRow, 46).Value = fGc
wsDactVol.Cells(davNextRow, 47).Value = rjGc
wsDactVol.Cells(davNextRow, 48).Value = rtGc
wsDActSumm.Cells(dasNextRow, 1).Value = dateArray(intI)
wsDActSumm.Cells(dasNextRow, 2).Value = actCnt
wsDActSumm.Cells(dasNextRow, 3).Value = consultantcount
wsDActSumm.Cells(dasNextRow, 4).Value = clientcount
wsDActSumm.Cells(dasNextRow, 5).Value = oAc
wsDActSumm.Cells(dasNextRow, 6).Value = cAc
wsDActSumm.Cells(dasNextRow, 7).Value = nfAc
wsDActSumm.Cells(dasNextRow, 8).Value = fAc
wsDActSumm.Cells(dasNextRow, 9).Value = rjAc
wsDActSumm.Cells(dasNextRow, 10).Value = rtAc
wsDActSumm.Cells(dasNextRow, 11).Value = oBc
wsDActSumm.Cells(dasNextRow, 12).Value = cBc
wsDActSumm.Cells(dasNextRow, 13).Value = nfBc
wsDActSumm.Cells(dasNextRow, 14).Value = fBc
wsDActSumm.Cells(dasNextRow, 15).Value = rjBc
wsDActSumm.Cells(dasNextRow, 16).Value = rtBc
wsDActSumm.Cells(dasNextRow, 17).Value = oCc
wsDActSumm.Cells(dasNextRow, 18).Value = cCc
wsDActSumm.Cells(dasNextRow, 19).Value = nfCc
wsDActSumm.Cells(dasNextRow, 20).Value = fCc
wsDActSumm.Cells(dasNextRow, 21).Value = rjCc
wsDActSumm.Cells(dasNextRow, 22).Value = rtCc
wsDActSumm.Cells(dasNextRow, 23).Value = oDc
wsDActSumm.Cells(dasNextRow, 24).Value = cDc
wsDActSumm.Cells(dasNextRow, 25).Value = nfDc
wsDActSumm.Cells(dasNextRow, 26).Value = fDc
wsDActSumm.Cells(dasNextRow, 27).Value = rjDc
wsDActSumm.Cells(dasNextRow, 28).Value = rtDc
wsDActSumm.Cells(dasNextRow, 29).Value = oEc
wsDActSumm.Cells(dasNextRow, 30).Value = cEc
wsDActSumm.Cells(dasNextRow, 31).Value = nfEc
wsDActSumm.Cells(dasNextRow, 32).Value = fEc
wsDActSumm.Cells(dasNextRow, 33).Value = rjEc
wsDActSumm.Cells(dasNextRow, 34).Value = rtEc
wsDActSumm.Cells(dasNextRow, 35).Value = oFc
wsDActSumm.Cells(dasNextRow, 36).Value = cFc
wsDActSumm.Cells(dasNextRow, 37).Value = nfFc
wsDActSumm.Cells(dasNextRow, 38).Value = fFc
wsDActSumm.Cells(dasNextRow, 39).Value = rjFc
wsDActSumm.Cells(dasNextRow, 40).Value = rtFc
wsDActSumm.Cells(dasNextRow, 41).Value = oGc
wsDActSumm.Cells(dasNextRow, 42).Value = cGc
wsDActSumm.Cells(dasNextRow, 43).Value = nfGc
wsDActSumm.Cells(dasNextRow, 44).Value = fGc
wsDActSumm.Cells(dasNextRow, 45).Value = rjGc
wsDActSumm.Cells(dasNextRow, 46).Value = rtGc
summNextRow = summNextRow + 1
davNextRow = davNextRow + 1
dasNextRow = dasNextRow + 1
consultantcount = 0
clientcount = 0
actCnt = 0
oAc = 0
oBc = 0
oCc = 0
oDc = 0
oEc = 0
oFc = 0
oGc = 0
cAc = 0
cBc = 0
cCc = 0
cDc = 0
cEc = 0
cFc = 0
cGc = 0
nfAc = 0
nfBc = 0
nfCc = 0
nfDc = 0
nfEc = 0
nfFc = 0
nfGc = 0
fAc = 0
fBc = 0
fCc = 0
fDc = 0
fEc = 0
fFc = 0
fGc = 0
rjAc = 0
rjBc = 0
rjCc = 0
rjDc = 0
rjEc = 0
rjFc = 0
rjGc = 0
rtAc = 0
rtBc = 0
rtCc = 0
rtDc = 0
rtEc = 0
rtFc = 0
rtGc = 0
Next 'intI (datearray loop)
'disconnect from TestDirector
If tdc.Connected Then
If tdc.ProjectConnected Then
tdc.DisconnectProject
End If
tdc.ReleaseConnection
End If
Application.StatusBar = "Disconnected from TestDirector."
'set up Detailed Defect History page first row header
wsDetailedHistory.Cells(1, 1).Value = "Defect ID"
wsDetailedHistory.Cells(1, 2).Value = "GT&E Defect ID"
wsDetailedHistory.Cells(1, 3).Value = "Detection Date"
wsDetailedHistory.Cells(1, 4).Value = "Priority"
wsDetailedHistory.Cells(1, 5).Value = "Summary"
wsDetailedHistory.Cells(1, 6).Value = "Status"
wsDetailedHistory.Cells(1, 7).Value = "Date Closed"
wsDetailedHistory.Cells(1, 8).Value = "Date Status Changed"
wsDetailedHistory.UsedRange.HorizontalAlignment = xlHAlignCenter
wsDetailedHistory.Columns("E").HorizontalAlignment = xlHAlignLeft
Set r1 = wsDetailedHistory.Rows(1)
r1.WrapText = True
wsDetailedHistory.Columns("A:D").AutoFit
wsDetailedHistory.Columns("F:J").AutoFit
wsDetailedHistory.UsedRange.Sort _
key1:="Defect ID", _
key2:="Date Status Changed", _
header:=xlYes
wsDetailedHistory.PageSetup.CenterHeader = "Detailed Defect History"
wsDetailedHistory.PageSetup.Orientation = xlLandscape
wsDetailedHistory.PageSetup.PrintGridlines = True
wsDetailedHistory.PageSetup.RightFooter = "&P/&N"
wsDetailedHistory.PageSetup.PrintTitleRows = wsDetailedHistory.Rows(1).Address
Set r1 = wsStatSheet.Range("A1", "D1")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(1, 1).Value = "Running Defect Totals"
Set r1 = wsStatSheet.Range("A2", "B2")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(2, 1).Value = "By Status"
Set r1 = wsStatSheet.Range("C2", "D2")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(2, 3).Value = "By Priority"
wsStatSheet.Cells(3, 1).Value = "Open"
wsStatSheet.Cells(4, 1).Value = "Closed"
wsStatSheet.Cells(5, 1).Value = "Not Fixed"
wsStatSheet.Cells(6, 1).Value = "Fixed"
wsStatSheet.Cells(7, 1).Value = "Rejected"
wsStatSheet.Cells(8, 1).Value = "Retest"
wsStatSheet.Cells(10, 1).Value = "Total"
wsStatSheet.Cells(3, 3).Value = "A"
wsStatSheet.Cells(4, 3).Value = "B"
wsStatSheet.Cells(5, 3).Value = "C"
wsStatSheet.Cells(6, 3).Value = "D"
wsStatSheet.Cells(7, 3).Value = "E"
wsStatSheet.Cells(8, 3).Value = "F"
wsStatSheet.Cells(9, 3).Value = "G"
wsStatSheet.Cells(10, 3).Value = "Total"
Dim stopat As Long
stopat = wsDActSumm.UsedRange.Rows.Count
For i = 2 To stopat
oT = oT + wsDActSumm.Cells(i, 5).Value + wsDActSumm.Cells(i, 11).Value + wsDActSumm.Cells(i, 17).Value + _
wsDActSumm.Cells(i, 23).Value + wsDActSumm.Cells(i, 29).Value + wsDActSumm.Cells(i, 35).Value + _
wsDActSumm.Cells(i, 41).Value
cT = cT + wsDActSumm.Cells(i, 6).Value + wsDActSumm.Cells(i, 12).Value + wsDActSumm.Cells(i, 18).Value + _
wsDActSumm.Cells(i, 24).Value + wsDActSumm.Cells(i, 30).Value + wsDActSumm.Cells(i, 36).Value + _
wsDActSumm.Cells(i, 42).Value
nfT = nfT + wsDActSumm.Cells(i, 7).Value + wsDActSumm.Cells(i, 13).Value + wsDActSumm.Cells(i, 19).Value + _
wsDActSumm.Cells(i, 25).Value + wsDActSumm.Cells(i, 31).Value + wsDActSumm.Cells(i, 37).Value + _
wsDActSumm.Cells(i, 43).Value
fT = fT + wsDActSumm.Cells(i, 8).Value + wsDActSumm.Cells(i, 14).Value + wsDActSumm.Cells(i, 20).Value + _
wsDActSumm.Cells(i, 26).Value + wsDActSumm.Cells(i, 32).Value + wsDActSumm.Cells(i, 38).Value + _
wsDActSumm.Cells(i, 44).Value
rjT = rjT + wsDActSumm.Cells(i, 9).Value + wsDActSumm.Cells(i, 15).Value + wsDActSumm.Cells(i, 21).Value + _
wsDActSumm.Cells(i, 27).Value + wsDActSumm.Cells(i, 33).Value + wsDActSumm.Cells(i, 39).Value + _
wsDActSumm.Cells(i, 45).Value
rtT = rtT + wsDActSumm.Cells(i, 10).Value + wsDActSumm.Cells(i, 16).Value + wsDActSumm.Cells(i, 22).Value + _
wsDActSumm.Cells(i, 28).Value + wsDActSumm.Cells(i, 34).Value + wsDActSumm.Cells(i, 40).Value + _
wsDActSumm.Cells(i, 46).Value
totA = totA + wsDActSumm.Cells(i, 5).Value + wsDActSumm.Cells(i, 6).Value + wsDActSumm.Cells(i, 7).Value + _
wsDActSumm.Cells(i, 8).Value + wsDActSumm.Cells(i, 9).Value + wsDActSumm.Cells(i, 10).Value
totB = totB + wsDActSumm.Cells(i, 11).Value + wsDActSumm.Cells(i, 12).Value + wsDActSumm.Cells(i, 13).Value + _
wsDActSumm.Cells(i, 14).Value + wsDActSumm.Cells(i, 15).Value + wsDActSumm.Cells(i, 16).Value
totC = totC + wsDActSumm.Cells(i, 17).Value + wsDActSumm.Cells(i, 18).Value + wsDActSumm.Cells(i, 19).Value + _
wsDActSumm.Cells(i, 20).Value + wsDActSumm.Cells(i, 21).Value + wsDActSumm.Cells(i, 22).Value
totD = totD + wsDActSumm.Cells(i, 23).Value + wsDActSumm.Cells(i, 24).Value + wsDActSumm.Cells(i, 25).Value + _
wsDActSumm.Cells(i, 26).Value + wsDActSumm.Cells(i, 27).Value + wsDActSumm.Cells(i, 28).Value
totE = totE + wsDActSumm.Cells(i, 29).Value + wsDActSumm.Cells(i, 30).Value + wsDActSumm.Cells(i, 31).Value + _
wsDActSumm.Cells(i, 32).Value + wsDActSumm.Cells(i, 33).Value + wsDActSumm.Cells(i, 34).Value
totF = totF + wsDActSumm.Cells(i, 35).Value + wsDActSumm.Cells(i, 36).Value + wsDActSumm.Cells(i, 37).Value + _
wsDActSumm.Cells(i, 38).Value + wsDActSumm.Cells(i, 39).Value + wsDActSumm.Cells(i, 40).Value
totG = totG + wsDActSumm.Cells(i, 41).Value + wsDActSumm.Cells(i, 42).Value + wsDActSumm.Cells(i, 43).Value + _
wsDActSumm.Cells(i, 44).Value + wsDActSumm.Cells(i, 45).Value + wsDActSumm.Cells(i, 46).Value
Next
wsStatSheet.Cells(3, 2).Value = oT
wsStatSheet.Cells(4, 2).Value = cT
wsStatSheet.Cells(5, 2).Value = nfT
wsStatSheet.Cells(6, 2).Value = fT
wsStatSheet.Cells(7, 2).Value = rjT
wsStatSheet.Cells(8, 2).Value = rtT
wsStatSheet.Cells(10, 2).Value = oT + cT + nfT + fT + rjT + rtT
wsStatSheet.Cells(3, 4).Value = totA
wsStatSheet.Cells(4, 4).Value = totB
wsStatSheet.Cells(5, 4).Value = totC
wsStatSheet.Cells(6, 4).Value = totD
wsStatSheet.Cells(7, 4).Value = totE
wsStatSheet.Cells(8, 4).Value = totF
wsStatSheet.Cells(9, 4).Value = totG
wsStatSheet.Cells(10, 4).Value = totA + totB + totC + totD + totE + totF + totG
Set r1 = wsStatSheet.Range("F1", "G1")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(1, 6).Value = "Not Fixed Information"
wsStatSheet.Cells(2, 6).Value = "Total Count"
wsStatSheet.Cells(3, 6).Value = "Rework Pct."
wsStatSheet.Cells(4, 6).Value = "Total NF"
wsStatSheet.Cells(5, 6).Value = "1 NF"
wsStatSheet.Cells(6, 6).Value = "2 NF"
wsStatSheet.Cells(7, 6).Value = "3 NF"
wsStatSheet.Cells(8, 6).Value = "4 NF"
wsStatSheet.Cells(9, 6).Value = "5 NF"
wsStatSheet.Cells(10, 6).Value = "6 NF"
wsStatSheet.Cells(11, 6).Value = "7 NF"
wsStatSheet.Cells(12, 6).Value = "8 NF"
wsStatSheet.Cells(13, 6).Value = "9 NF"
wsStatSheet.Cells(14, 6).Value = "10 NF"
wsStatSheet.Cells(15, 6).Value = "11 NF"
wsStatSheet.Cells(16, 6).Value = "12 NF"
wsStatSheet.Cells(17, 6).Value = "13 NF"
wsStatSheet.Cells(18, 6).Value = "14 NF"
wsStatSheet.Cells(19, 6).Value = "15 NF"
wsStatSheet.Cells(20, 6).Value = "16 NF"
wsStatSheet.Cells(21, 6).Value = "17 NF"
wsStatSheet.Cells(22, 6).Value = "18 NF"
wsStatSheet.Cells(23, 6).Value = "19 NF"
wsStatSheet.Cells(24, 6).Value = "20+ NF"
wsStatSheet.Columns("A:G").AutoFit
Dim nfarray() As String
ReDim nfarray(csnf)
Dim nfcount As Long
nfcount = 1
Dim rwcnt As Long
rwcnt = wsDetailedHistory.UsedRange.Rows.Count
For i = 1 To rwcnt
If wsDetailedHistory.Cells(i, 6).Value = "Not Fixed" Then
wsStatSheet.Cells(nfcount, 9).Value = wsDetailedHistory.Cells(i, 1).Value
nfcount = nfcount + 1
End If
Next
wsStatSheet.Cells(2, 7).Value = nfcount
Dim curr As String
curr = ""
For i = 1 To wsStatSheet.UsedRange.Rows.Count
curr = wsStatSheet.Cells(i, 9).Value
If curr <> "" Then
cnt = Application.WorksheetFunction.CountIf(wsStatSheet.UsedRange, curr)
Select Case cnt
Case 1
onetime = onetime + 1
Case 2
twotime = twotime + 1
i = i + 1
Case 3
threetime = threetime + 1
i = i + 2
Case 4
fourtime = fourtime + 1
i = i + 3
Case 5
fivetime = fivetime + 1
i = i + 4
Case 6
sixtime = sixtime + 1
i = i + 5
Case 7
seventime = seventime + 1
i = i + (cnt - 1)
Case 8
eighttime = eighttime + 1
i = i + (cnt - 1)
Case 9
ninetime = ninetime + 1
i = i + (cnt - 1)
Case 10
tentime = tentime + 1
i = i + (cnt - 1)
Case 11
eleventime = eleventime + 1
i = i + (cnt - 1)
Case 12
twelvetime = twelvetime + 1
i = i + (cnt - 1)
Case 13
thirteentime = thirteentime + 1
i = i + (cnt - 1)
Case 14
fourteentime = fourteentime + 1
i = i + (cnt - 1)
Case 15
fifteentime = fifteentime + 1
i = i + (cnt - 1)
Case 16
sixteentime = sixteentime + 1
i = i + (cnt - 1)
Case 17
seventeentime = seventeentime + 1
i = i + (cnt - 1)
Case 18
eightteentime = eightteentime + 1
i = i + (cnt - 1)
Case 19
nineteentime = nineteentime + 1
i = i + (cnt - 1)
Case 20
twentytime = twentytime + 1
i = i + (cnt - 1)
Case Else
twentytime = twentytime + 1
i = i + (cnt - 1)
End Select
End If
Next
wsStatSheet.Cells(4, 7).Value = onetime + twotime + threetime + fourtime + fivetime + sixtime + _
seventime + eighttime + ninetime + tentime + eleventime + twelvetime + _
thirteentime + fourteentime + fifteentime + sixteentime + seventeentime + _
eightteentime + nineteentime + twentytime
wsStatSheet.Cells(5, 7).Value = onetime
wsStatSheet.Cells(6, 7).Value = twotime
wsStatSheet.Cells(7, 7).Value = threetime
wsStatSheet.Cells(8, 7).Value = fourtime
wsStatSheet.Cells(9, 7).Value = fivetime
wsStatSheet.Cells(10, 7).Value = sixtime
wsStatSheet.Cells(11, 7).Value = seventime
wsStatSheet.Cells(12, 7).Value = eighttime
wsStatSheet.Cells(13, 7).Value = ninetime
wsStatSheet.Cells(14, 7).Value = tentime
wsStatSheet.Cells(15, 7).Value = eleventime
wsStatSheet.Cells(16, 7).Value = twelvetime
wsStatSheet.Cells(17, 7).Value = thirteentime
wsStatSheet.Cells(18, 7).Value = fourteentime
wsStatSheet.Cells(19, 7).Value = fifteentime
wsStatSheet.Cells(20, 7).Value = sixteentime
wsStatSheet.Cells(21, 7).Value = seventeentime
wsStatSheet.Cells(22, 7).Value = eightteentime
wsStatSheet.Cells(23, 7).Value = nineteentime
wsStatSheet.Cells(24, 7).Value = twentytime
For i = 1 To wsStatSheet.UsedRange.Rows.Count 'delete defect ID from Stat Sheet column 9
wsStatSheet.Cells(i, 9).Value = ""
Next
Set r1 = wsStatSheet.Range("A13", "B13")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(13, 1).Value = "By Status"
Set r1 = wsStatSheet.Range("C13", "D13")
r1.Merge
r1.HorizontalAlignment = xlCenter
wsStatSheet.Cells(13, 3).Value = "By Priority"
wsStatSheet.Cells(14, 1).Value = "Open"
wsStatSheet.Cells(15, 1).Value = "Closed"
wsStatSheet.Cells(16, 1).Value = "Not Fixed"
wsStatSheet.Cells(17, 1).Value = "Fixed"
wsStatSheet.Cells(18, 1).Value = "Rejected"
wsStatSheet.Cells(19, 1).Value = "Retest"
wsStatSheet.Cells(21, 1).Value = "Total"
wsStatSheet.Cells(14, 3).Value = "A"
wsStatSheet.Cells(15, 3).Value = "B"
wsStatSheet.Cells(16, 3).Value = "C"
wsStatSheet.Cells(17, 3).Value = "D"
wsStatSheet.Cells(18, 3).Value = "E"
wsStatSheet.Cells(19, 3).Value = "F"
wsStatSheet.Cells(20, 3).Value = "G"
wsStatSheet.Cells(21, 3).Value = "Total"
wsSummary.Activate
Application.StatusBar = False
'gives control of the statusbar back to the programme
Application.ScreenUpdating = True
'save to remote drive
Dim destpath As String
Dim localpath As String
Dim svDate As String
Dim fName As String
Dim myDir As String
fName = ActiveWorkbook.Name
destpath = "string showing the path to the directory on local/shared drive that stores file."
svDate = Format(Date, "mmddyyyy")
fName = destpath + "\" + svDate + "-" + fName
'MsgBox (fName) 'debug
ActiveWorkbook.SaveCopyAs fName
ActiveWorkbook.Save
'sanity check: Open + Not* + Fixed + Closed = Total defects
If wsSummary.Cells(summNextRow, 5) + wsSummary.Cells(summNextRow, 8) + wsSummary.Cells(summNextRow, 11) + _
wsSummary.Cells(summNextRow, 14) <> wsSummary.Cells(summNextRow, 2) Then
MsgBox ("There is a problem with the data. The sum of Open, Not Fixed, Fixed, and Closed is not equal to the Total Defects.")
EmailProblemReport (fName)
Else
'email report to appropriate people.
EmailReport (fName)
End If
'delete pages, save & Close document.
wsStatSheet.Delete 'this page is created each day, so delete it from workbook.
wsDetailedHistory.Delete 'this page is created each day, so delete it from workbook.
ActiveWorkbook.Save
Application.StatusBar = False
Application.ScreenUpdating = True
ActiveWorkbook.Save
'clean up/release objects.
Set r1 = Nothing
Set hisRec = Nothing
Set hisList = Nothing
Set his = Nothing
Set bgl = Nothing
Set bgf = Nothing
Set tdc = Nothing
Set wsDactVol = Nothing
Set wsDActSumm = Nothing
Set wsSummary = Nothing
Set wsDetailedHistory = Nothing
Set wsStatSheet = Nothing
CheckError:
If tdc.Connected Then
If tdc.ProjectConnected Then
tdc.DisconnectProject
End If
tdc.ReleaseConnection
End If
If Err.Number <> 0 Then
MsgBox ("UpdateReport" & vbCrLf & "Error: " & Err.Number & vbCrLf & Err.Description)
End If
Application.StatusBar = False
Set r1 = Nothing
Set hisRec = Nothing
Set hisList = Nothing
Set his = Nothing
Set bgl = Nothing
Set bgf = Nothing
Set tdc = Nothing
Set wsDactVol = Nothing
Set wsDActSumm = Nothing
Set wsSummary = Nothing
Set wsDetailedHistory = Nothing
Set wsStatSheet = Nothing
End Sub