Posts by Username99

Username99 · Dec 12th 2006

Re: Inserting Hyperlink

Sorry I haven't got back to you sooner, but I came up with some code very similar to the one you posted. All works well and thanks for the assistance. :cool:

Username99 · Dec 6th 2006

Re: Inserting Hyperlink

It definetely has something to do with the .HTMLBody I am using. I just tried using .Body without the Signature1 and it worked. I went back and added Signature1 and it produced alot of junk, junk I wouldn't get if I was using .HTMLBody

Suggestions are always appreciated.

Username99 · Dec 6th 2006

Re: Inserting Hyperlink

No such luck.

Here's what I currently have.

Code

Private Sub CommandButton1_Click()
If ComboBox1.Value = "NAME" Then
    Dim olApp_1 As Outlook.Application
    Dim objMail_1 As Outlook.MailItem
    Dim SigString1 As String
    Dim Signature1 As String
    Set olApp_1 = Outlook.Application
    'Create e-mail item
    Set objMail_1 = olApp_1.CreateItem(olMailItem)
    Set myRecipientTO1_1 = objMail_1.Recipients.Add("NAME")
                  
    SigString1 = "C:\Documents and Settings\NAME.warminster\Application Data\Microsoft\Signatures\NAME.htm"
    If Dir(SigString1) <> "" Then
    Signature1 = GetBoiler(SigString1)
    Else
    Signature1 = ""
    End If
     
Unload UserForm2
    
   With objMail_1
       .Subject = TextBox1.Value + " " + TextBox3.Value + " PDF Signoffs & Dumps"
       .BodyFormat = olFormatPlain
'       .HTMLBody = "<HTML><BODY>Betty – " & "<br>" & "File are now available on the server " + TextBox4.Value & "<br><br>" & Signature1
       .HTMLBody = "<HTML><BODY><file:\\SERVER\Imaging\Softproof\>" & Signature1
       .Display
       
    End With
   
Else
MsgBox "Please select a CSR."
End If
End Sub

Display More

The reason I have the .HTMLBody is because I'm pulling in Signature1.

I've also tried the following:

Code

Private Sub CommandButton1_Click()
If ComboBox1.Value = "NAME" Then
    Dim olApp_1 As Outlook.Application
    Dim objMail_1 As Outlook.MailItem
    Dim SigString1 As String
    Dim Signature1 As String
    Set olApp_1 = Outlook.Application
    'Create e-mail item
    Set objMail_1 = olApp_1.CreateItem(olMailItem)
    Set myRecipientTO1_1 = objMail_1.Recipients.Add("NAME")
                  
    SigString1 = "C:\Documents and Settings\NAME.warminster\Application Data\Microsoft\Signatures\NAME.htm"
    If Dir(SigString1) <> "" Then
    Signature1 = GetBoiler(SigString1)
    Else
    Signature1 = ""
    End If
     
Unload UserForm2
    
   With objMail_1
       .Subject = TextBox1.Value + " " + TextBox3.Value + " PDF Signoffs & Dumps"
       .BodyFormat = olFormatPlain
'       .HTMLBody = "<HTML><BODY>Betty – " & "<br>" & "File are now available on the server " + TextBox4.Value & "<br><br>" & Signature1
       .Body = "<file:\\SERVER\Imaging\Softproof\>"
       .Display
       
    End With
   
Else
MsgBox "Please select a CSR."
End If
End Sub

Display More

This result produces "<file:\\SERVER\Imaging\Softproof\>" in the body of my email without a hyperlink.

Not quite sure what's up with this..... :confused:

Username99 · Dec 6th 2006

Re: Inserting Hyperlink

The hyperlink is to a networked folder. Thus when I send out the email, the recipient will click on the link thus opening up a new window so they can browse the files located within that folder.

Yes the textboxs work along with all other controls.

Username99 · Dec 5th 2006

Re: Inserting Hyperlink

Alright,I thank you for getting back to me. I did some testing with no such luck.

Below is what I came up with trying to understand how the hyperlink code works.

Any suggestions?

Code

Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function


Private Sub CommandButton1_Click()
If ComboBox1.Value = "Test Name" Then
    Dim olApp_1 As Outlook.Application
    Dim objMail_1 As Outlook.MailItem
    Dim SigString1 As String
    Dim Signature1 As String
    Set olApp_1 = Outlook.Application
    'Create e-mail item
    Set objMail_1 = olApp_1.CreateItem(olMailItem)
    Set myRecipientTO1_1 = objMail_1.Recipients.Add("Test Name")
                  
    SigString1 = "C:\Documents and Settings\Microsoft\Signatures\Name.htm"
    If Dir(SigString1) <> "" Then
    Signature1 = GetBoiler(SigString1)
    Else
    Signature1 = ""
    End If
     
Unload UserForm2
    
   With objMail_1
       .Subject = TextBox1.Value + " " + TextBox3.Value + " Some Kind Of Test For Me"
       .BodyFormat = olFormatPlain
       .HTMLBody = "<HTML><BODY>This is a test" & "<file:\\Test Server\Loo Here\>"
       .Display
       
    End With
   
Else
MsgBox "Please select a NAME."
End If
End Sub

Display More

Username99 · Dec 4th 2006

Re: Inserting Hyperlink

Alright, let me back up. I need this for Outlook, not Excel. Sorry if I left out any information.

Username99 · Dec 4th 2006

Does anyone know what the code is to insert a hyperlink? Oviously you can go to to Insert > Hyperlink. I currently have a macro to create an automatic email based on certain criteria.

Is there anyway to do this based on a line or two of code?

Username99 · Oct 9th 2006

Re: Search For String And Print

Not 100% sure how to accomplish that.....

Username99 · Oct 9th 2006

Re: Search For String And Print

Got a slight problem. Seems as though when one my the users ran this, they got unexpected results. In this case, the W5WW or W6WW will be on the 2nd page of the record, in most case it'll be on the 1st page.

I've done some testing and can't seem to find a way around this.

Help would be appreciated. Attached is the current code and word doc showing the bug.

Code

Function MyFind(MyDoc As Document, FirstItem As String, EndItem As String) As String
     
    Dim strPage As String
     
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = FirstItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
         
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = EndItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = strPage & CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
     
    If strPage <> "" Then
         '        Remove Trailing Comma
        strPage = Left(strPage, Len(strPage) - 1)
    End If
     
    MyFind = strPage
     
End Function
Sub PRINT_W5WW_W6WW()
ActiveWindow.Close
CommandBars("Task Pane").Visible = False
Dim docTemp As Document
     
Dim strOrigPath As String
strOrigPath = Options.DefaultFilePath(Path:=wdDocumentsPath)
Options.DefaultFilePath(Path:=wdDocumentsPath) = "V:\audit\internal\"
CommandBars.FindControl(ID:=23).Execute
Options.DefaultFilePath(Path:=wdDocumentsPath) = strOrigPath


    If Application.Documents.Count >= 1 Then
        For Each docTemp In Application.Documents
            If docTemp.FullName <> ThisDocument.FullName Then
                 
                strPage = MyFind(docTemp, "W5WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                strPage = MyFind(docTemp, "W6WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                docTemp.Close False
            End If
        Next
Dim Msg, Style, Response, MyString
Msg = "Do you want to quit?"    ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.


Response = MsgBox(Msg, Style)
If Response = vbYes Then    ' User chose Yes.
Application.Quit
Else    ' User chose No.
End If


    End If
End Sub

Display More

Username99 · Oct 5th 2006

Re: Search For String And Print

Well this morning I didn't reboot my PC and its working. It wasn't working as of yesterday at 4:30 and it seems like some resets over night or during the reboot to cause things to work again.

Awww what a nightmare of a macro.

Username99 · Oct 5th 2006

Re: Search For String And Print

The funny part about this is now it works. But later today, I'll get those same error messages. Not sure what to think about this anymore....

Username99 · Oct 4th 2006

Re: Search For String And Print

I cleaned up the code a bit and restarted the computer and tried opening word docs and all was fine. No error messages as described in my prior post. So I thought, ok lets test the macro and again all was fine. But I tried opening an entirely different word doc after the macro was run and both those error messages came up.

Any idea what the problem could be with the macro? Code has been attached.

Code

Sub PRINT_W5WW_W6WW()
'ActiveWindow.Close
'CommandBars("Task Pane").Visible = False
Dim docTemp As Document
     
Dim strOrigPath As String
strOrigPath = Options.DefaultFilePath(Path:=wdDocumentsPath)
Options.DefaultFilePath(Path:=wdDocumentsPath) = "V:\audit\internal\"
CommandBars.FindControl(ID:=23).Execute
Options.DefaultFilePath(Path:=wdDocumentsPath) = strOrigPath


    If Application.Documents.Count >= 1 Then
        For Each docTemp In Application.Documents
            If docTemp.FullName <> ThisDocument.FullName Then
                 
                strPage = MyFind(docTemp, "W5WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                strPage = MyFind(docTemp, "W6WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                docTemp.Close False
            End If
        Next
Dim Msg, Style, Response, MyString
Msg = "Do you want to quit?"    ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.


Response = MsgBox(Msg, Style)
If Response = vbYes Then    ' User chose Yes.
Application.Quit
Else    ' User chose No.
End If


    End If
End Sub
Function MyFind(MyDoc As Document, FirstItem As String, EndItem As String) As String
     
    Dim strPage As String
     
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = FirstItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
         
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = EndItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = strPage & CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
     
    If strPage <> "" Then
         '        Remove Trailing Comma
        strPage = Left(strPage, Len(strPage) - 1)
    End If
     
    MyFind = strPage
     
End Function

Display More

Username99 · Oct 3rd 2006

Re: Search For String And Print

See that was my first intial thought. Well I cleaned up the Normal.dot to include only the code needed for the W5WW & W6WW. I'll test tomorrow again and see if the "rouge code" is gone.

Username99 · Oct 3rd 2006

Re: Search For String And Print

I attached a zip file containing an error when opening up any word doc. Any ideas? I have a feeling its related to the macro I've been working on but tried a few things with no such luck of fixing the error.

Once I click Ok and then End the document itself opens up.

Username99 · Oct 3rd 2006

Re: Search For String And Print

Slight problem. Take a look at the code. If a user selects only 1 file, the only thing it does it opens the document up but skips the printing of the W5WW and W6WW. Is there something I have missed?

Code

Sub PRINT_W5WW_W6WW()
'ActiveWindow.Close
'CommandBars("Task Pane").Visible = False
Dim docTemp As Document
     
Dim strOrigPath As String
strOrigPath = Options.DefaultFilePath(Path:=wdDocumentsPath)
Options.DefaultFilePath(Path:=wdDocumentsPath) = "V:\audit\internal\"
CommandBars.FindControl(ID:=23).Execute
Options.DefaultFilePath(Path:=wdDocumentsPath) = strOrigPath


    If Application.Documents.Count > 1 Then
        For Each docTemp In Application.Documents
            If docTemp.FullName <> ThisDocument.FullName Then
                 
                strPage = MyFind(docTemp, "W5WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                strPage = MyFind(docTemp, "W6WW", "1101...5")
                If strPage <> "" Then
                    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
                    wdPrintDocumentContent, Copies:=1, Pages:=strPage, PageType:=wdPrintAllPages, _
                    ManualDuplexPrint:=False, Collate:=True, Background:=True, PrintToFile:= _
                    False, PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _
                    PrintZoomPaperHeight:=0
                End If
                 
                docTemp.Close False
            End If
        Next
        Application.Quit
    End If
End Sub
Function MyFind(MyDoc As Document, FirstItem As String, EndItem As String) As String
     
    Dim strPage As String
     
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = FirstItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
         
        Selection.Find.ClearFormatting
        With Selection.Find
            .Text = EndItem
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
            strPage = strPage & CStr(Selection.Range.Information(wdActiveEndAdjustedPageNumber)) & "-"
        End If
     
    If strPage <> "" Then
         '        Remove Trailing Comma
        strPage = Left(strPage, Len(strPage) - 1)
    End If
     
    MyFind = strPage
     
End Function

Display More

Username99 · Oct 3rd 2006

Re: Search For String And Print

What's the easiest way to install the macro on my machine or other machines within the department?

Username99 · Oct 3rd 2006

Re: Search For String And Print

Solution found. I just threw together a quick batch file which opens word, then each user clicks on on the marco on their toolbar (once its installed on each machine) and it runs the macro and tada, all selected documents printed off.

1.) How would I installed this marco on other machines?

2.) Is there a command to close word automaticly after the macro is finished?

Username99 · Oct 3rd 2006

Re: Search For String And Print

I agree on the opening of word anyways. They'll look at it as give us an icon/exe to click on which will open word for us automaticly and process each file and close word.

Well I think I'll leave it the way it is now and they can convert to vbscript if they want.

Username99 · Oct 3rd 2006

Re: Search For String And Print

I know this is probably getting out of my knowledge here but is there any way to execute a macro outside of word? I mean its easy enough to open word, and click on the macro and it runs itself. I'm sure people where I work will bitch cause they have to open word each time to execute.

A buddy mine said vbscript, which I am not familiar with. Any other easy ways?

Username99 · Oct 3rd 2006

Re: Search For String And Print

Actually, is there anyway to give a defualt directory to open up to?