We help IT Professionals succeed at work.
Get Started
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\manife
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
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 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 <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
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