clientdocuments.vb

这是一个VBA开发的项目实例

            'newDocName = mainDoc.Name       
            docApp.Selection.Paste()
            docApp.Selection.HomeKey(unit:=6)
            'start replacing customer data values.
            clientConnection.Open()
            strSqlStatement = "SELECT * FROM tblClients WHERE Client_ID = " & varCompanyName.SharedClientID
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            While clientDataReader.Read
                Call findandreplace("<<CLIENT BUSINESS NAME>>", IIf(IsDBNull(clientDataReader.Item(1)), "NA", clientDataReader.Item(1)))
                Call findandreplace("<<ADDRESS LINE>>", IIf(IsDBNull(clientDataReader.Item(4)), "NA", clientDataReader.Item(4)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(5)), "NA", clientDataReader.Item(5)))
                Call findandreplace("<<CITY>>", IIf(IsDBNull(clientDataReader.Item(6)), "NA", clientDataReader.Item(6)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(7)), "NA", clientDataReader.Item(7)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(8)), "NA", clientDataReader.Item(8)))
            End While
            clientDataReader.Close()
            clientConnection.Close()

            'start replacing sales rep data
            clientConnection.Open()
            strSqlStatement = "SELECT * FROM tblSalesRep"
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            While clientDataReader.Read
                Call findandreplace("<<SALESREP>>", IIf(IsDBNull(clientDataReader.Item(1)), "NA", clientDataReader.Item(1)))
                Call findandreplace("<<OUR ADDRESS LINE>>", IIf(IsDBNull(clientDataReader.Item(3)), "NA", clientDataReader.Item(3)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(4)), "NA", clientDataReader.Item(4)))
                Call findandreplace("<<OURCITY>>", IIf(IsDBNull(clientDataReader.Item(5)), "NA", clientDataReader.Item(5)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(6)), "NA", clientDataReader.Item(6)) + Chr(13) + IIf(IsDBNull(clientDataReader.Item(7)), "NA", clientDataReader.Item(7)))
            End While
            clientDataReader.Close()
            clientConnection.Close()

            'Collect the issues for this customer and replace in Proposal.
            clientConnection.Open()
            strSqlStatement = "SELECT Expectation FROM tblClientExpectations WHERE selected = True AND Client_ID = " & varCompanyName.SharedClientID
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            varIssues = "The Following Issues were discussed:" + Chr(13) + Chr(13)

            While clientDataReader.Read
                varIssues = varIssues + clientDataReader.Item(0) + Chr(13) + Chr(13)
            End While
            clientDataReader.Close()
            clientConnection.Close()
            Call findandreplace("<<ISSUESMENTIONED>>", varIssues)

            'Collect the solutions for this customer and replace in Proposal.
            clientConnection.Open()
            strSqlStatement = "SELECT solution FROM tblClientSolutions WHERE selected = True AND Client_ID = " & varCompanyName.SharedClientID
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            varSolutions = "The Following Solutions are Suggested:" + Chr(13) + Chr(13)

            While clientDataReader.Read
                varSolutions = varSolutions + clientDataReader.Item(0) + Chr(13) + Chr(13)
            End While
            clientDataReader.Close()
            clientConnection.Close()
            Call findandreplace("<<SUGGESTEDSOLUTIONS>>", varSolutions)

            varProducts = "This Proposal is offered for following product(s):" + Chr(13)
            If chkbCompPaper.Checked = True Then
                varProducts = varProducts + Chr(13) + "Computer Paper"
            End If
            If chkbCopyPaper.Checked = True Then
                varProducts = varProducts + Chr(13) + "Copy Paper"
            End If
            If chkbGelInkPen.Checked = True Then
                varProducts = varProducts + Chr(13) + "Gel Ink Pen"
            End If
            If chkbHighlighter.Checked = True Then
                varProducts = varProducts + Chr(13) + "HighLighter"
            End If
            If chkbScotchTape.Checked = True Then
                varProducts = varProducts + Chr(13) + "Scotch Tape"
            End If
            If chkbGlueStic.Checked = True Then
                varProducts = varProducts + Chr(13) + "Glue Stic"
            End If
            Call findandreplace("<<PRODUCTS>>", varProducts)
            Call findandreplace("<<PDATE>>", ProposalDate.Text)
            Call findandreplace("<<EDATE>>", ExpiryDate.Text)

            tempDoc = Nothing
            mainDoc = Nothing
            docApp = Nothing

        Catch
            MsgBox(Err.Description)
        End Try



    End Sub

    Public Sub findandreplace(ByVal findtext As String, ByVal replacementText As String)
        Dim flag As Integer
        Dim var As Boolean

        docApp.Selection.Find.ClearFormatting()
        docApp.Selection.Find.Replacement.ClearFormatting()
        With docApp.Selection.Find
            .Text = findtext
            .Replacement.Text = replacementText
            .Forward = True
            .Wrap = 1
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        flag = 1
        Do While flag = 1
            var = docApp.Selection.Find.Execute
            If var = True Then
                With docApp.Selection
                    If .Find.Forward = True Then
                        .Collapse(Direction:=1)
                    Else
                        .Collapse(Direction:=0)
                    End If
                    .Find.Execute(Replace:=1)
                    If .Find.Forward = True Then
                        .Collapse(Direction:=0)
                    Else
                        .Collapse(Direction:=1)
                    End If

                End With
            Else
                flag = 0
            End If
        Loop

    End Sub
    Public Sub PresentationCreation()
        Dim ppApp As PowerPoint.Application
        Dim ppOne As PowerPoint.Presentation
        Dim ppTwo As PowerPoint.Presentation
        Dim ppslide As PowerPoint.Slide
        Dim ppShape As PowerPoint.Shape
        Dim varLength As Long
        Dim varSalesRepInfo As String
        Dim varSalesRepName As String
        Dim varIssues As String
        Dim IssuesCount As Integer
        Dim SolutionsCount As Integer
        Dim VarSlideNumber As Integer
        Dim varSolutions As String

        Try
            ppApp = CType(CreateObject("PowerPoint.Application"), PowerPoint.Application)
            ppApp.Visible = True
            ppApp.Presentations.Add()
            ppOne = ppApp.ActivePresentation
            ppOne.ApplyTemplate("c:\easyselling\presentation.ppt")
            varLength = ppOne.Slides.InsertFromFile("c:\easyselling\presentation.ppt", 0, 1, 6)
            'get sales rep data
            clientConnection.Open()
            strSqlStatement = "SELECT * FROM tblSalesRep"
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            While clientDataReader.Read
                varSalesRepName = IIf(IsDBNull(clientDataReader.Item(1)), "NA", clientDataReader.Item(1))
                varSalesRepInfo = IIf(IsDBNull(clientDataReader.Item(1)), "NA", clientDataReader.Item(1)) + Chr(13)
                varSalesRepInfo = varSalesRepInfo + IIf(IsDBNull(clientDataReader.Item(2)), "NA", clientDataReader.Item(2)) + Chr(13)
                varSalesRepInfo = varSalesRepInfo + IIf(IsDBNull(clientDataReader.Item(11)), "NA", clientDataReader.Item(11)) + Chr(13)

            End While
            clientDataReader.Close()
            clientConnection.Close()
            'get issues
            clientConnection.Open()
            strSqlStatement = "SELECT Expectation FROM tblClientExpectations WHERE selected = True AND Client_ID = " & varCompanyName.SharedClientID
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            While clientDataReader.Read
                varIssues = varIssues + clientDataReader.Item(0) + Chr(13)
            End While
            clientDataReader.Close()
            clientConnection.Close()
            'get solutions
            clientConnection.Open()
            strSqlStatement = "SELECT solution FROM tblClientSolutions WHERE selected = True AND Client_ID = " & varCompanyName.SharedClientID
            clientCommand = New OleDbCommand(strSqlStatement, clientConnection)
            clientDataReader = clientCommand.ExecuteReader()
            While clientDataReader.Read
                varSolutions = varSolutions + clientDataReader.Item(0) + Chr(13)
            End While
            clientDataReader.Close()
            clientConnection.Close()
            'replace data
            For Each ppslide In ppOne.Slides
                For Each ppShape In ppslide.Shapes
                    If ppShape.HasTextFrame = True Then
                        ppShape.TextFrame.TextRange.Replace("<<Customer Company>>", varCompanyName.SharedValue)
                        ppShape.TextFrame.TextRange.Replace("<<SalesRep>>", varSalesRepInfo)
                        ppShape.TextFrame.TextRange.Replace("<<SalesRepName>>", varSalesRepName)
                        ppShape.TextFrame.TextRange.Replace("<<IssuesItems>>", varIssues)
                        ppShape.TextFrame.TextRange.Replace("<<SolutionItems>>", varSolutions)

                    End If
                Next
            Next

            ppShape = Nothing
            ppslide = Nothing
            ppOne = Nothing
            ppApp = Nothing
        Catch
            MsgBox(Err.Description)
        End Try

    End Sub

End Class