Creating a file from a HTML string in VB6 Pro

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

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LVL 13

rettiseertCommented: 2010-03-29

You can save any string in a file like this:

open "c:\filepath.htm" for output as #345
print #345, theString
close #345

Tylendal1Author Commented: 2010-03-29

rettiseert:
I tried this: Open htmlEmail For Output As "k:\ddpmed\nobel000\manifest\Manifest032010.html"
htmlEmail being the string I wish to save as the file "Manifest032010.html. No errors but no file is created in the folder I specified.
What did I miss in your solution.
Fred

Tylendal1Author Commented: 2010-03-30

I see where I might have made a mistake. I modified my code as follows
Open "k:\ddpmed\nobel000\manifest\Manifest032010.html" For Output As #1
Print #1, htmlEmail
Close #1

But again I'm not seeing the file "k:\ddpmed\nobel000\manifest\Manifest032010.html" created.
Not sure what I'm doing incorrectly, but would appreciate your feed back.
Fred

rettiseertCommented: 2010-03-30

Really? And you don't get any error message? The posted code should work. Did you double checked for the file existence?

Here is another way:

Dim FSO

Set FSO = CreateObject("Scripting.FileSystemObject")

Call FSO.OpenTextFile(FilePath, ForWriting, True).Write(htmlEmail)

Yo may need to change the code I posted to:

Dim FSO

Set FSO = CreateObject("Scripting.FileSystemObject")

Call FSO.OpenTextFile(FilePath, 2, True).Write(htmlEmail)

rettiseert:
Using your last solution I created this code.
Dim FSO
Dim FilePath
FilePath = "k:\ddpmed\nobel000\manifest\TestDocument.doc"
Set FSO = CreateObject("Scripting.FileSystemObject")
Call FSO.OpenTextFile(FilePath, 2, True).Write(htmlEmail)
I get no errors but the file is not created. I'm not sure what I'm missing or doing wrong.
Im using VB6.0 Professional on a Windows_XP Professional machine. The string "htmlEmail" exists as I see it if I use debug.print. I'm sure I'm doing something stupid or I have missed something you have assumed I know. Sorry for all the problems as I feel this is really a simple issue that your two solutions should have worked. What have I missed/
Fred

Hello

Your code seems fine, I don't see anything missing, if there's a problem you should get an error. If you just create an empty windows form project and try the code it shoud run fine.

For example, try this (don't change the code, just try it and see if "c:\file.htm" is created):

open "c:\file.htm" for output as #1
print #1, "<html>This is a test</html>"
close #1

perhaps k: is a network drive and you dont have permissios to list directory contents there.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial

rettiseert:
Well using you sample code and it worked. Substituting my string "htmlEmal" and it worked also. I then substituted K for C and it worked also. Then I changed K for K:\ddpmed and that worked also. Then I changed to k:\ddpmed\nobel000 and it failed. It was at this point that it dawned on me what the problem is or I suspect it is. The folder K:\ddpmed\nobel000\manifest\ is a folder I created as part of our FTP Server and while I can paste to a folder there with no problems creating and writing to it will require something additional I'm thinking. Do you have any thoughts on this?

Tylendal1Author Commented: 2010-03-31

Thank you for your time and patients. the solution was perfect and worked as needed. You final coments about trying it on my C drive allowed me to discover what the issue was and had nothing to do with you simple and direct solution. Again, thank you.

Creating a file from a HTML string in VB6 Pro

Who is Participating?