We help IT Professionals succeed at work.
Get Started

Creating a file from a HTML string in VB6 Pro

390 Views
Last Modified: 2013-11-25
I have a program (exe) that creates a string that is composed of HTML data.  See attached code.  the program works just fine as it send an email with html hyperlinks.  What I need is to be able to take the created string and write it to a file.  The output htmlEmail is a string and becomes the htmlBody of the email being sent.   As you can see from the attachment the output is a string.  I tried this  htmlEmail.Copy "K:\ddpmed\NOBLE000\manifest\Mani032910.html" but it required that htmlEmail be an Object but there is no file created when its executed.

I know I'm missing something but not sure how to save html in a file and then write the file to disk.  I make the assumption that the saved file will still have the hyperlinks.

Appreciate some direction as to how to create the file so the hyperlinks can be utilized when the file is opened.

Thank you.
Fred


Sub AllCompanies()
    On Error Resume Next
    Dim db As Database
    Dim rst As Recordset   ' TodayEBlast records from qryEmailBlast
    Dim mSV As Recordset   ' ShipVerification
    Dim mSQL As String
    Dim mFName As String
    Dim mMName As String
    Dim mLName As String
    Dim mName As String

    
Set db = OpenDatabase("V:\Main\ManiEmail\FileConsolidation.mdb")
    Set mSV = db.OpenRecordset("ShipVerification")
    Set rst = db.OpenRecordset("TodayEBlast")
    If Not rst.BOF Then
        rst.MoveLast
        rst.MoveFirst
    Else
        MsgBox "No records for EmailBlast", 48, "No Data"
        Exit Sub
    End If
    
    Do While Not rst.EOF
        ' procdure to make "LastName, FirstName, Initial"
        If rst!CustomerName <> rst!ShiptoName Then
            If InStr(1, rst!ShiptoName, "&") <> 0 Or _
                InStr(1, rst!ShiptoName, ",") <> 0 Then
                GoTo NextRSTrecord  ' unable to reposition to lastname, firstname
            End If
            
            mName = rst!ShiptoName
            mFName = Left(mName, (InStr(1, mName, " ") - 1))
            mName = Mid(mName, (InStr(1, mName, " ") + 1), Len(mName))
            
            If InStr(1, mName, " ") <> 0 Then  'there is a middle initial
                If Len(Left(mName, InStr(1, mName, " ") - 1)) = 1 Then
                    ' example "David L Green"
                    mFName = mFName & " " & Left(mName, 1)
                    mLName = Mid(mName, 3, Len(mName))
                Else
                    If InStr(1, mName, "JR") <> 0 Or InStr(1, mName, "II") <> 0 Or _
                        InStr(1, mName, "III") <> 0 Or InStr(1, mName, "Jr") <> 0 Then
                        mLName = mName
                    Else
                    ' example name "L David Green" or "David Larry Green"
                    mFName = mFName & " " & Left(mName, InStr(1, mName, " ") - 1) 'Left(mName, 1)
                    mLName = Mid(mName, (InStr(1, mName, " ") + 1), Len(mName)) '3, Len(mName))
                    End If
                End If
            Else
                ' example "David Green"
                mLName = mName
            End If
            rst.Edit
                rst!ShiptoName = mLName & ", " & mFName
            rst.Update
        End If
NextRSTrecord:
        If Not rst.EOF Then
            rst.MoveNext
        Else
            Exit Do
        End If
    Loop
    Set rst = db.OpenRecordset("qryEmailBlast")
    If Not rst.BOF Then
        rst.MoveLast
        rst.MoveFirst
    Else
        MsgBox "No data, coding error.", 48, "No Data"
        Exit Sub
    End If
    Do While Not rst.EOF
        '' records are sorted by customer number, ship to name ascending
        'Build HTML file header
        mEnd = ""
        mCt = 0
        mCustomerName = Trim(rst!CustomerName)
        mCustomerID = Trim(rst!CustomerID)
        mEmailAddress = Trim(rst!EmailAddress)
        mDate = Format(rst!sDate, "yyyy") & "-" & Format(rst!sDate, "mm") _
                & "-" & Format(rst!sDate, "dd")
        frmTracking.InformationTextBox.Text = mCustomerName & " " & mCustomerID & " for " & mDate
        htmlHeader = "<html>" & "<head>" & "<style type=""text/css"">"
        htmlHeader = htmlHeader & ".style1" & "{" & "font-family: Calibri;"
        htmlHeader = htmlHeader & "font-size: x-small;" & "font-weight: bold;"
        htmlHeader = htmlHeader & "text-align: left;" & "}" & ".style2" & "{"
        htmlHeader = htmlHeader & "font-family: Calibri;" & "font-size: x-small;"
        htmlHeader = htmlHeader & "font-weight: bold;" & "text-align: center;"
        htmlHeader = htmlHeader & "}" & "</style>" & "</head>" & "<body>"
        htmlHeader = htmlHeader & "<p class=""style1"" height: 20px"">" & "Account: "
        htmlHeader = htmlHeader & UCase(mCustomerName) & ", " & UCase(mCustomerID)
        htmlHeader = htmlHeader & "<br />" & "Orders Shipped on: " & mDate
        htmlHeader = htmlHeader & "</p>" & "<table class=""style2"" align=""left"" cellpadding=""5"" cellspacing=""0"" >"
        htmlHeader = htmlHeader & "<tr>" & "<td><u>Customer Name</u></td>"
        htmlHeader = htmlHeader & "<td><u>Patient ID</u></td>"
        htmlHeader = htmlHeader & "<td><u>Zip Code</u></td>"
        htmlHeader = htmlHeader & "<td><u>PO #</td></u>"
        htmlHeader = htmlHeader & "<td><u>Order #</u></td>"
        htmlHeader = htmlHeader & "<td><u>     Tracking #</u></td>"
        'Packages will be NA for USPS items
        'htmlHeader = htmlHeader & "<td><u>Packages</u></td></tr>"
        htmlHeader = htmlHeader & "<td><u>Carrier</u></td></tr>"
        
        'Create HTML body
        htmlBodyFull = ""
        htmlBody = ""
        Do While mCustomerID = rst!CustomerID
            mShipToName = Trim(rst!ShiptoName)
            If IsNull(rst!PatientID) Then
                mPatientID = ""
            Else
                mPatientID = Trim(rst!PatientID)
            End If
            mZipCode = Trim(rst!ZipCode)
            If Trim(rst!CustomerID) = "3TF6723" Then
                If IsNull(rst!ExtCustPONo) Then
                    mCustPoNo = ""
                Else
                    mCustPoNo = Trim(rst!ExtCustPONo)
                End If
            Else
                If IsNull(rst!CustPONo) Then
                    mCustPoNo = ""
                Else
                    mCustPoNo = Trim(rst!CustPONo)
                End If
            End If
            mABCOrderNo = Trim(rst!ABCOrderNo)
            mTrackingNo = Trim(rst!TrackingNo)
            If InStr(1, mTrackingNo, "1Z") <> 0 Then
                mPackages = "UPS"  'Trim(rst!packages)
            Else
                mPackages = "USPS"
            End If
            
        
            htmlBody = "<tr>" & "<td>" & mShipToName & "</td>"
            htmlBody = htmlBody & "<td>" & mPatientID & "</td>"
            htmlBody = htmlBody & "<td>" & mZipCode & "</td>"
            htmlBody = htmlBody & "<td>" & mCustPoNo & "</td>"
            htmlBody = htmlBody & "<td>" & mDDPOrderNo & "</td>"
            If InStr(1, mTrackingNo, "1Z") Then
                htmlBody = htmlBody & "<td><a HREF=""http://wwwapps.ups.com/WebTracking/processRequest?"
                htmlBody = htmlBody & "HTMLVersion=5.0&Requester=NES&AgreeToTermsAndConditions=yes&loc=en_US&tracknum="
                htmlBody = htmlBody & "" & mTrackingNo & """>" & mTrackingNo & "</a></td>"
            Else
                htmlBody = htmlBody & "<td><a HREF=""http://trkcnfrm1.smi.usps.com/PTSInternetWeb/InterLabelInquiry.do?CAMEFROM=OK&strOrigTrackNum="
                htmlBody = htmlBody & "" & mTrackingNo & """>" & mTrackingNo & "</a></td>"
            End If
            htmlBody = htmlBody & "<td>" & mPackages & "</td></tr>"
            mCt = mCt + 1
'&& CDate(mDate), mCustomerID, mABCOrderNo -- add to ShipVerification
                
            If mCt < 5 Then
                mEnd = mEnd & "<br />"
            Else
                mEnd = mEnd & "<br /><br />"
                'Print rst!CustomerID & " " & mEnd
            End If
            If Not rst.EOF Then
NextRecord:
                    rst.MoveNext
                'Compile table rows for email
                htmlBodyFull = htmlBodyFull & vbCrLf & htmlBody & vbCrLf
                If rst.EOF Then
                    Exit Do
                End If
            Else
                'Compile table rows for email
                htmlBodyFull = htmlBodyFull & vbCrLf & htmlBody & vbCrLf
                Exit Do
            End If
        Loop
'&&  CDate(mDate), mCustomerID, mCt  -- add to ShipVerification

        mSV.AddNew
            mSV!sDate = CDate(mDate)
            mSV!CustNo = mCustomerID
            mSV!EM = mCt
        mSV.Update
        ' reduce size of mEnd
        If mCt > 20 And mCt < 100 Then
            Do While mCt <> 20
                mEnd = Right(mEnd, Len(mEnd) - 6)
                mCt = mCt - 1
            Loop
        End If
        If mCt >= 100 Then
            Do While mCt <> 20
                mEnd = Right(mEnd, Len(mEnd) - 12)
                mCt = mCt - 1
            Loop
        End If
        'Close HTML tags
        htmlEnd = "</table>" & _
                    "<br /><br /><br /><br />" & _
                    "</body>" & _
                    "</html>" & mEnd

        'Note
        htmlNote = "<html>" & "<head>" & "<title></title>" & "<style type=""text/css"">"
        htmlNote = htmlNote & "p.MsoNormal" & "{margin:0in;" & "margin-bottom:.0001pt;"
        htmlNote = htmlNote & "font-size:11.0pt;" & "font-family:""Calibri"",""sans-serif"";}"
        htmlNote = htmlNote & "}" & "</style>" & "</head>" & "<body>"
        htmlNote = htmlNote & "<p class=""MsoNormal"">"
        htmlNote = htmlNote & "<span style=""FONT-SIZE: 10pt; FONT-FAMILY: 'Segoe UI','sans-serif'""><o:p></o:p>"
        htmlNote = htmlNote & "<p><b>NOTE:</b><br/>"
        htmlNote = htmlNote & "The information listed is for both USPS and UPS shipments.<br/>"
        htmlNote = htmlNote & "Clicking on a tracking number will take you directly to the Carrier's<br/>"
        htmlNote = htmlNote & "website so you can print out the delivery information.</p>"
        htmlNote = htmlNote & "<p>The information is stored by the Carrier for no more than Ninety (90) days.<br/>"
        htmlNote = htmlNote & "  " & "If you have any questions please contact your<br/>"
        htmlNote = htmlNote & "ABC Customer Service Representative at 1-800-555-1212.</p>"
        htmlNote = htmlNote & "</body>" & "</html>"
        
        
        'Signature
        htmlSignature = "<html>" & "<head>" & "<title></title>" & "<style type=""text/css"">"
        htmlSignature = htmlSignature & "p.MsoNormal" & "{margin:0in;" & "margin-bottom:.0001pt;"
        htmlSignature = htmlSignature & "font-size:11.0pt;" & "font-family:""Calibri"",""sans-serif"";}"
        htmlSignature = htmlSignature & "a:link" & "{color:blue;" & "text-decoration:underline;"
        htmlSignature = htmlSignature & "}" & "</style>" & "</head>" & "<body>"
        htmlSignature = htmlSignature & "<p class=""MsoNormal"">" & "<b><span style=""FONT-SIZE: 10pt; FONT-FAMILY: 'Lucida Handwriting'"">"
        htmlSignature = htmlSignature & "<img id=""Picture_x0020_1"" alt=""ABC Supply Logo"" height=""29"""
        htmlSignature = htmlSignature & "src=""E:\ABCManifestEmail\ABCLogo.bmp"" width=""137"" /></span><u><span"
        htmlSignature = htmlSignature & "style=""FONT-SIZE: 10pt; COLOR: blue; FONT-FAMILY: 'Segoe UI','sans-serif'""><o:p></o:p></span></u></b></p>"
        htmlSignature = htmlSignature & "<p class=""MsoNormal"">" & "<b><span style=""FONT-SIZE: 12pt; FONT-FAMILY: 'Lucida Handwriting'"">Customer "
        htmlSignature = htmlSignature & "Service<o:p></o:p></span></b></p>" & "<p class=""MsoNormal"">"
        htmlSignature = htmlSignature & "<span style=""FONT-SIZE: 10pt; FONT-FAMILY: 'Segoe UI','sans-serif'"">85851 10th Street North <o:p></o:p>"
        htmlSignature = htmlSignature & "</span>" & "</p>" & "<p class=""MsoNormal"">" & "<span style=""FONT-SIZE: 10pt; FONT-FAMILY: 'Segoe UI','sans-serif'"">St. "
        htmlSignature = htmlSignature & "Marcus, MN&nbsp; 99999<o:p></o:p></span></p>" & "<p class=""MsoNormal"">"
        htmlSignature = htmlSignature & "<span style=""FONT-SIZE: 10pt; FONT-FAMILY: 'Segoe UI','sans-serif'"">P: "
        htmlSignature = htmlSignature & "800.555.1212 F: 800.555.1212&nbsp;&nbsp; <o:p></o:p></span>" & "</p>" & "<p class=""MsoNormal"">"
        htmlSignature = htmlSignature & "<b><u>" & "<span style=""FONT-SIZE: 10pt; COLOR: blue; FONT-FAMILY: 'Segoe UI','sans-serif'"">"
        htmlSignature = htmlSignature & "<a href=""mailto:abc@abcsupply.com""" & "title=""blocked::mailto:abc@abcsupply.com"">abc@abcsupply.com</a><o:p></o:p></span></u></b></p>"
        htmlSignature = htmlSignature & "</body>" & "</html>"
        
        'Compile full email
        'htmlEmail = htmlHeader & vbCrLf & htmlBodyFull & vbCrLf & htmlEnd & vbCrLf & htmlSignature & "<br />" & "<br />"
        htmlEmail = htmlHeader & vbCrLf & htmlBodyFull & htmlEnd & vbCrLf & htmlNote & vbCrLf & htmlSignature
        
        'Send Email
        subSendEmail
        htmlBodyFull = ""
        htmlBody = ""
    Loop
    
End Sub

Open in new window

Comment
Watch Question
This problem has been solved!
Unlock 1 Answer and 9 Comments.
See Answer
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE