Private Declare Function GetUserName Lib advapi32 Alias

Document Sample
Private Declare Function GetUserName Lib advapi32 Alias Powered By Docstoc
					Private Declare Function GetUserName Lib "advapi32" Alias "GetUserNameA" (ByVal
lpBuffer As String, nSize As Long) As Long



Sub References()
'_______________________________________________________
'Set up objects
'_______________________________________________________
Dim caliberserver_factory As caliberserverfactory
Dim caliber_server As caliberserver
Dim cailber_session As CaliberObject
Dim my_session As Session
Dim my_project As CaliberRM.Project
Dim my_baseline As Baseline
Dim my_requirement_type As RequirementType
Dim my_requirements As Requirement
Dim my_test As Requirement

Dim my_attributes As AttributeValue
Dim no_of_attributes, i As Integer
Dim start_time As Date
Dim finish_time As Date
Dim my_ref As DocumentReference
Dim my_pic As FileReference
Dim rngText As Range
start_time = Time

Set caliberserver_factory = New caliberserverfactory
'host name of Caliber Server
Set caliber_server = caliberserver_factory.Create(UserForm1.txt_server.Text)
'("192.168.168.40")
'login to Caliber Server
Set my_session = caliber_server.login(UserForm1.txt_user.Text,
UserForm1.txt_password.Text) '("admin", "admin")

no_of_project = my_session.Projects.Count


'automatic teller machine project
Set my_project = my_session.Projects.item(1)
Debug.Print my_project.Name
no_of_baselines = my_project.Baselines.Count

'current baseline
 Set my_baseline = my_project.CurrentBaseline

 'first requirement
 Set my_requirements = my_baseline.Requirements.item(0)

 WriteToDoc my_requirements, my_session

my_session.logout

End Sub

Private Sub Document_New()

End Sub

Private Sub Document_Open()
UserForm1.Show
End Sub

Sub WriteToDoc(my_requirements As Requirement, my_session As Session)
'check if business requirement
Dim rngText As Range

  'If my_pic Is Nothing Then
    Dim im As ImageManager
    Set im = my_session.ImageManager
       Debug.Print my_requirements.Name
       Debug.Print my_requirements.IDNumber
       'Debug.Print "PATH: "; my_pic.Path

      'writing out requirement name to the word doc
       no_of_par = ActiveDocument.Paragraphs.Count
       Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
        With rngText
          .Bold = True
          .Font.Size = 20
          .Text = "Requirement:- " & my_requirements.Name
        End With
       ActiveDocument.Paragraphs.Add
      'The description is stored in HTML format therefore requires to be written to
      'a file before being inserted into the word document

      'Sort out HTML dsecription
      Html_file = my_requirements.Description.Text

      im.populateCache2 (Html_file)
      my_windows_user = rgbGetUserName
      'C:\Documents and Settings\dcarson\.caliberrm

       my_image_path = "C:\Documents and Settings\" + my_windows_user +
"\.caliberrm"


       'my_image_path = "C:\Documents and Settings\" + my_windows_user + "\Local
Settings\Application Data\Borland\CaliberRM\ImageCache"
       newhtml = Replace(Html_file, "C:/Documents and Settings/dcarson/.caliberrm",
my_image_path)
       Debug.Print newhtml
       newhtml2 = Replace(newhtml, "\", "/")
       Debug.Print newhtml2
       newhtml3 = Replace(newhtml2, "border=" + """" + "0" + """", "border=" + """" +
"0" + """" + " Width=" + """" + "400" + """")
       Debug.Print newhtml3
       file_name = "C:/" + my_requirements.Name + Str(my_requirements.IDNumber) +
".html"
       Debug.Print file_name

     If UserForm1.CheckBox2.Value = True Then
      'writing out html file
      Open file_name For Output As #1
       Print #1, newhtml3 'Html_file
      Close #1

      'insert description
       no_of_par = ActiveDocument.Paragraphs.Count
       Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
        With rngText
          .Bold = True
          .Font.Size = 16
          .Text = vbTab + "Requirement Description:- "
       End With
       ActiveDocument.Paragraphs.Add


     'insert description
     no_of_par = ActiveDocument.Paragraphs.Count
      Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
       With rngText
         .InsertFile file_name
      End With
      ActiveDocument.Paragraphs.Add
     End If
If my_requirements.DocumentReferences.Count > 0 Then
  Debug.Print my_requirements.Name
  Set my_pic = my_requirements.DocumentReferences.item(0)
     'Find out extension of reference file
     'mypos = InStr(my_pic.Path, ".")
     'mypos = InStr(mypos + 1, my_pic.Path, ".")
     myexten = Mid(my_pic.Path, Len(my_pic.Path) - 2)

    Debug.Print myexten

    'Test if it is a word documents
   If myexten = "doc" Or myexten = "DOC" Then
    'inserting file name into word doc

    no_of_par = ActiveDocument.Paragraphs.Count
    Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
     With rngText
      .Bold = True
      .Font.Size = 16
      .Text = vbTab + "Reference: " + my_pic.Path
    End With
    ActiveDocument.Paragraphs.Add


    no_of_par = ActiveDocument.Paragraphs.Count
    Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
     With rngText
      .InsertFile my_pic.Path
    End With
    ActiveDocument.Paragraphs.Add

   'adding page break to word document
   no_of_par = ActiveDocument.Paragraphs.Count
   Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
    With rngText
      .InsertBreak wdPageBreak
   End With
   ActiveDocument.Paragraphs.Add
   End If


   If myexten = "gif" Or myexten = "jpg" Or myexten = "bmp" Then
    'inserting file name into word doc

    no_of_par = ActiveDocument.Paragraphs.Count
       Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
       With rngText
         .Bold = True
         .Font.Size = 16
         .Text = vbTab + "Reference: " + my_pic.Path
       End With
       ActiveDocument.Paragraphs.Add


       no_of_par = ActiveDocument.Paragraphs.Count

       Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
       With rngText
         .InlineShapes.AddPicture my_pic.Path
         '.insertpicture my_pic.Path
       End With
       ActiveDocument.Paragraphs.Add

      'adding page break to word document
      no_of_par = ActiveDocument.Paragraphs.Count
      Set rngText = ActiveDocument.Paragraphs(no_of_par).Range
       With rngText
         .InsertBreak wdPageBreak
      End With
      ActiveDocument.Paragraphs.Add
      End If

    'End If
   End If

End Sub
Private Function rgbGetUserName() As String
Dim MAX_USERNAME As Long
MAX_USERNAME = 256
 'return the name of the user
  Dim tmp As String

 tmp = Space$(MAX_USERNAME)

 If GetUserName(tmp, Len(tmp)) Then
   rgbGetUserName = TrimNull(tmp)
 End If

End Function
Private Function TrimNull(item As String)
 Dim pos As Integer

 pos = InStr(item, Chr$(0))

 If pos Then
   TrimNull = Left$(item, pos - 1)
 Else
   TrimNull = item
 End If

End Function

				
DOCUMENT INFO
Shared By:
Categories:
Stats:
views:9
posted:4/16/2010
language:English
pages:6