Option Compare Database

Sub bugzilla_export()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
     
     
    Dim oFilesys, oFiletxt
    Set oFilesys = CreateObject("Scripting.FileSystemObject")
    Set oFiletxt = oFilesys.CreateTextFile("bugzilla_migration.xml", True)
    oFiletxt.WriteLine ("<?xml version=""1.0"" encoding=""UTF-8""?>")
    oFiletxt.WriteLine ("<bugzilla version=""3.2.2"" urlbase=""http://10.31.217.134/bugzilla/"" maintainer=""myemail@mycompany.com"" exporter=""myemail@mycompany.com"">")
     
    Set db = CurrentDb()
     'may want to limit the imported bugs
    strSQL = "SELECT problems.*, module.module_name, categories.cname, tblApp.AppName, priority.pname, status.sname, departments.dname, test_case.test_case_name, uUsers.uid, uUsers.fname, uUsers.email1, enteredby.uid, enteredby.fname, enteredby.email1, Rep.*, * FROM (tblUsers AS uUsers RIGHT JOIN ((([module] RIGHT JOIN ((((problems LEFT JOIN test_case ON problems.test_case_id = test_case.test_case_id) LEFT JOIN priority ON problems.priority = priority.priority_id) LEFT JOIN tblUsers AS Rep ON problems.rep = Rep.sid) LEFT JOIN status ON problems.status = status.status_id) ON module.module_id = problems.module_name) LEFT JOIN departments ON problems.department = departments.department_id) LEFT JOIN (categories LEFT JOIN tblApp ON categories.appid = tblApp.AppId) ON problems.category = categories.category_id) ON uUsers.uid = problems.uid) LEFT JOIN tblUsers AS enteredby ON problems.entered_by = enteredby.sid " _
            & "WHERE (((tblApp.AppName) Is Not Null And (tblApp.AppName)<>'PA-Old') AND status <> 150) ORDER BY problems.id;"
    Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
    Do While (Not rst.EOF)
                
        bug_id = escapeXML(rst.Fields("id").Value)
        alias = escapeXML(Replace(rst.Fields("AppName").Value & "-" & rst.Fields("defect_display_id").Value, " ", "_"))
        creation_ts = timestampFormat(rst.Fields("start_date").Value)
        short_desc = escapeXML(rst.Fields("title").Value)
        If (rst.Fields("sname").Value = "CLOSED") Then
            delta_ts = timestampFormat(rst.Fields("close_date").Value) 'last modified
        Else
            delta_ts = creation_ts 'last modified
        End If
        product = escapeXML(rst.Fields("AppName").Value)
        bversion = escapeXML(rst.Fields("cname").Value)
        bug_status = getStatus(rst.Fields("sname").Value) 'need to check the mapping
        'bug_file_loc = rst.Fields("").Value
        'priority = rst.Fields("pname").Value 'need to check the mapping
        bug_severity = getSeverity(rst.Fields("pname").Value) 'need to check the mapping
        'target_milestone = rst.Fields("").Value
        
        If rst.Fields("uUsers.fname").Value <> "" Then
            reporter_name = escapeXML(rst.Fields("uUsers.fname").Value)
        Else
            reporter_name = escapeXML(rst.Fields("problems.uid").Value)
        End If
        If rst.Fields("uUsers.email1").Value <> "" Then
            reporter_email = escapeXML(rst.Fields("uUsers.email1").Value)
        Else
            reporter_email = escapeXML(rst.Fields("uemail").Value)
        End If
        
        assigned_to_name = escapeXML(rst.Fields("rep.fname").Value) 'may want to check these against the tblUsers and then use username if nothing is found
        assigned_to_email = escapeXML(rst.Fields("rep.email1").Value) 'may want to check these against the tblUsers and then use username if nothing is found
        
        qa_contact_name = reporter_name 'may want to check these against the tblUsers and then use username if nothing is found
        qa_contact_email = reporter_email 'may want to check these against the tblUsers and then use username if nothing is found
        group = product
        who_name1 = reporter_name
        who_email1 = reporter_email
        bug_when = creation_ts
        thetext = escapeXML(rst.Fields("description").Value)
        
        output = "    <bug>"
        output = output & "          <bug_id>" & bug_id & "</bug_id>"
        output = output & "          <alias>" & alias & "</alias>"
        output = output & "          <creation_ts>" & creation_ts & "</creation_ts>"
        output = output & "          <short_desc>" & short_desc & "</short_desc>"
        output = output & "          <delta_ts>" & delta_ts & "</delta_ts>"
        output = output & "          <reporter_accessible>1</reporter_accessible>"
        output = output & "          <cclist_accessible>1</cclist_accessible>"
        output = output & "          <classification_id>2</classification_id>"
        output = output & "          <classification>RFS</classification>"
        output = output & "          <product>" & product & "</product>"
        output = output & "          <component>Unspecified</component>"
        output = output & "          <version>" & bversion & "</version>"
        output = output & "          <rep_platform>All</rep_platform>"
        output = output & "          <op_sys>All</op_sys>"
        output = output & "          <bug_status>" & bug_status & "</bug_status>"
        If (bug_status = "RESOLVED") Then
            output = output & "          <resolution>FIXED</resolution>"
        End If
        
        
        'output = output & "          <bug_file_loc/>" & bug_file_loc & "</bug_file_loc>"
        output = output & "          <priority>P3</priority>"
        output = output & "          <bug_severity>" & bug_severity & "</bug_severity>"
        output = output & "          <target_milestone>---</target_milestone>"
        output = output & "          <everconfirmed>1</everconfirmed>"
        output = output & "          <reporter name=""" & reporter_name & """>" & reporter_email & "</reporter>"
        output = output & "          <assigned_to name=""" & assigned_to_name & """>" & assigned_to_email & "</assigned_to>"
        output = output & "          <estimated_time>0.00</estimated_time>"
        output = output & "          <remaining_time>0.00</remaining_time>"
        output = output & "          <actual_time>0.00</actual_time>"
        output = output & "          <qa_contact name=""" & qa_contact_name & """>" & qa_contact_email & "</qa_contact>"
        'output = output & "          <cf_env>Dev</cf_env>"
        'output = output & "          <cf_user>userrolename</cf_user>"
        'output = output & "          <cf_url>another URL</cf_url>"
        output = output & "          <group>Contingency Plan</group>"
        output = output & "          <long_desc isprivate=""0"">"
        output = output & "            <who name=""" & who_name1 & """>" & who_email1 & "</who>"
        output = output & "            <bug_when>" & bug_when & "</bug_when>"
        output = output & "            <thetext>" & thetext & "</thetext>"
        output = output & "          </long_desc>"
        
        strSQL2 = "SELECT tblNotes.*, tblUsers.fname, tblUsers.email1 FROM tblNotes LEFT JOIN tblUsers ON tblNotes.uid = tblUsers.uid WHERE (((tblNotes.private)<>1) AND ((tblNotes.id)=" & rst.Fields("id").Value & ")) ORDER BY tblNotes.id, tblNotes.addDate;"
        Set rst2 = db.OpenRecordset(strSQL2, dbOpenDynaset)
        Do While (Not rst2.EOF)
            
            If rst2.Fields("fname").Value <> "" Then
                who_name2 = escapeXML(rst2.Fields("fname").Value)
            Else
                who_name2 = escapeXML(rst2.Fields("uid").Value)
            End If
            
            If rst2.Fields("email1").Value <> "" Then
                who_email2 = escapeXML(rst2.Fields("email1").Value)
            Else
                who_email2 = escapeXML(rst2.Fields("uid").Value)
            End If
            bug_when2 = timestampFormat(rst2.Fields("addDate").Value)
            thetext2 = escapeXML(rst2.Fields("note").Value)
            
            output = output & "          <long_desc isprivate=""0"">"
            output = output & "            <who name=""" & who_name2 & """>" & who_email2 & "</who>"
            output = output & "            <bug_when>" & bug_when2 & "</bug_when>"
            output = output & "            <thetext>" & thetext2 & "</thetext>"
            output = output & "          </long_desc>"
            
            rst2.MoveNext
        Loop
        
        output = output & "    </bug>"
        oFiletxt.WriteLine (output)
        
        rst.MoveNext
    Loop
    oFiletxt.WriteLine ("</bugzilla>")
    oFiletxt.Close
    
End Sub

Function getStatus(strInput As String)
    'status  sname
    '1   OPEN
    '100 FIXED
    '150 CLOSED
    Select Case strInput
    Case "OPEN"
        getStatus = "ASSIGNED"
    Case "FIXED"
        getStatus = "RESOLVED"
    Case "CLOSED"
        getStatus = "CLOSED"
     End Select
End Function

Function getSeverity(strInput As String)
    'priority   pname
    '1  SHOW STOPPER
    '2  CRITICAL
    '3  MEDIUM
    '5  MINOR
    Select Case strInput
    Case "SHOW STOPPER"
        getSeverity = "S1 Critical"
    Case "CRITICAL"
        getSeverity = "S2 High"
    Case "MEDIUM"
        getSeverity = "S3 Medium"
    Case "MINOR"
        getSeverity = "S4 Low"
    End Select
End Function

Function timestampFormat(strInput As String)
    '2009-02-03 15:10:22
    dtInput = CDate(strInput)
    timestampFormat = Year(dtInput) & "-" & Lpad(Month(dtInput), "0", 2) & "-" & Lpad(Day(dtInput), "0", 2) & " " & FormatDateTime(dtInput, vbShortTime) & ":" & Lpad(Second(dtInput), "0", 2)
End Function

Function Lpad(MyValue, MyPadChar, MyPaddedLength)
Lpad = String(MyPaddedLength - Len(MyValue), MyPadChar) & MyValue
End Function

Function escapeXML(strInput)
    If (IsNull(strInput)) Then
        escapeXML = Null
        Exit Function
    End If
    
    'First, check that characaters are within the ANSI (http://en.wikipedia.org/wiki/ISO-8859-1) or Windows 1252 (http://en.wikipedia.org/wiki/Windows-1252)
    strInput = characterCodeCheck(strInput)

    'Ampersand   &amp;   &   &#38;#38;
    'Left angle bracket  &lt;    <   &#38;#60;
    'Right angle bracket &gt;    >   &#62;
    'Straight quotation mark &quot;  "   &#39;
    'Apostrophe  &apos;
    uniqueStr = "!@#$%^*()"
    strOutput = Replace(strInput, "&", uniqueStr)
    strOutput = Replace(strOutput, "<", "&lt;")
    strOutput = Replace(strOutput, ">", "&gt;")
    strOutput = Replace(strOutput, """", "&quot;")
    strOutput = Replace(strOutput, "'", "&apos;")
    strOutput = Replace(strOutput, uniqueStr, "&amp;")
    escapeXML = strOutput
End Function

'Deletes characers outside of the expected range
Function characterCodeCheck(strInput)
    Dim i
    For i = 0 To 31
        strInput = Replace(strInput, Chr(i), "")
    Next i
    For i = 127 To 159
        strInput = Replace(strInput, Chr(i), "")
    Next i

    characterCodeCheck = strInput
End Function