Can I use vbs script code like this? (1 Viewer)

Lensmeister · Oct 7, 2014

Hi all,

Currently this is in the theory stage of a DB I am planning, if I pursue the DB any further I need to know if I can do this.

I am hoping to create a Database but from the the data within a table I need to create a web page.

I know that you can save a table as a webpage but we need to have the pages with te companies corperate styles and logos.

I used to have a sweet little vbs script that when you ran it would create a page from a template.

Can the code in the vbs script be used in a macro in access (my preferred choice) by clicking on a button on a form?

Or

Could the vbs script be triggered from a button in a form in access?

I will be using Access 2010 on Windows 7.

Thanks for any advice/help you can give.

Lensmeister · Oct 7, 2014

This is the vbs I would like to use (this is the version I used on an older project the new DB is totally different).

Code:

Const ForReading = 1, ForWriting = 2
strFilePath = "1871.html"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(strFilePath,ForWriting,True)
' open database
set db = CreateObject("ADODB.Connection")
db.Open("DRIVER={Microsoft Access Driver (*.mdb)}; DBQ=" & mypath & "aafhg.mdb")
' use SQL to select information
sql = "SELECT c1871.Surname, c1871.Forname, c1871.Rel, c1871.Cond, c1871.Age, c1871.Trade, c1871.where_born, c1871.Piece, c1871.Folio, c1871.address, c1871.Contributed FROM c1871 ORDER BY c1871.Piece, c1871.Folio, c1871.Age DESC;"
set rs = db.Execute(sql)
' write the header
ts.writeline "<html>"
ts.writeline "<head>"
ts.writeline "<body bgcolor=" & Chr(34) & "#FFFFFF" & Chr(34) & " alink=" & Chr(34) & "#FF0000" & Chr(34) & " vlink=" & Chr(34) & "#FF0000" & Chr(34) & "> "
ts.writeline "<center><h2>1871 CENSUS EXTRACTS</h2><br>"
ts.writeline "<h2>Austrians in England and Wales</h2><br></center><br>"
ts.writeline "<p>"
ts.writeline "<a href=" & Chr(34) & "1871.html#a" & Chr(34) & ">A</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#b" & Chr(34) & ">B</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#c" & Chr(34) & ">C</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#d" & Chr(34) & ">D</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#e" & Chr(34) & ">E</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#f" & Chr(34) & ">F</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#g" & Chr(34) & ">G</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#h" & Chr(34) & ">H</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#i" & Chr(34) & ">I</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#j" & Chr(34) & ">J</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#k" & Chr(34) & ">K</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#l" & Chr(34) & ">L</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#m" & Chr(34) & ">M</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#n" & Chr(34) & ">N</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#o" & Chr(34) & ">O</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#p" & Chr(34) & ">P</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#q" & Chr(34) & ">Q</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#r" & Chr(34) & ">R</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#s" & Chr(34) & ">S</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#t" & Chr(34) & ">T</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#u" & Chr(34) & ">U</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#v" & Chr(34) & ">V</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#w" & Chr(34) & ">W</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#x" & Chr(34) & ">X</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#y" & Chr(34) & ">Y</a>"
ts.writeline "<a href=" & Chr(34) & "1871.html#z" & Chr(34) & ">Z</a></p>"
 
ts.writeline "<p><table border cellspacing=1><tr><td><b>Surname</b></td><td><b>Forname</b></td><td><b>Rel.</b></td><td><b>Cond.</b></td><td><b>Age</b></td><td><b>Trade</b></td><td><b>Where Born</b></td><td><b>Piece</b></td><td><b>Folio</b></td><td><b>Address</b></td><td><b>Contributed</b></td></tr>"
ts.writeline "<tr><td><b>A</b><a name=A></a></td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td><td> </td></tr>"
' read resulting record set
FirstLetter = 65
do until rs.EOF
 If Asc(left(rs("Surname"),1)) > FirstLetter then
  FirstLetter = Asc(left(rs("Surname"),1))
  ts.writeline "<tr><td><b>" & Chr(FirstLetter) & "</b><a name=" & Chr(FirstLetter) & "></a></td><td> </td><td> </td><td> </td>"
  ts.writeline "<td><a href=" & Chr(34) & "1871.html#top" & Chr(34) & ">Click here to return to top</a></td></tr>"
 End if
 ts.writeline "<tr><td>" & RplBlank(rs("Surname")) & "</td><td>" & RplBlank(rs("Forname")) & "</td><td>" & RplBlank(rs("Rel")) & "</td><td>" & RplBlank(rs("Cond")) & "</td><td>" & RplBlank(rs("Age")) & "</td><td>" & RplBlank(rs("Trade")) & "</td><td>" & RplBlank(rs("Where_Born")) & "</td><td>" & RplBlank(rs("Piece")) & "</td><td>" & RplBlank(rs("Folio")) & "</td><td>" & RplBlank(rs("Address")) & "</td><td>" & RplBlank(rs("Contributed")) & "</td></tr>"
 rs.MoveNext
'  <td>" & rs("Surname") & "</td><td>" & rs("Forname") & "</td><td>" & RplBlank(rs("Rel")) & "</td><td>" & RplBlank(rs("Cond")) & "</td><td>" & rs("Age") & "</a><td>" & rs("Trade") & "</td><td>" & rs("Where_Born") & "</td><td>" & rs("Piece") & "</td><td>" & rs("Folio") & "</td><td>" & rs("Address") & "</td><td>" & rs("Contribute") & "</td>
loop
ts.writeline "</table>"
ts.writeline "</body>"
ts.close
Function RplBlank(FieldVal)
 
 if isnull(FieldVal) then
  RplBlank = " "
 else
  RplBlank = FieldVal
 end if
End Function

Jibbadiah · Oct 7, 2014

You can create HTML using VBA and include links to online images using the <IMG src> tag. I have done the same for emails generated from an Access db and delivered using Outlook. Sample script below. It gives you the ability to tailor colours, etc as well based on extracted values. I assume that the same principles apply for what you're trying to do. It can be problematic to debug when you write code within code.

'Create HTML body text for email
strMessage = "<IMG src=""" & "http://website/sampleimage.jpg" & """ width=250 height=80 v:shapes=""" & "_x0000_i1025" & """ FixClip='1'>" & _
" " & _
"Dear " & strRecipient & ", " & _
" " & _
"Please find attached a summary of the information this week " & _
" " & _
"Your team received a total of " & dblTotalLeads & " leads across " & dblTotalManagers & " managers. " & _
" " & dblTotalActioned & strActionedSentence & " submitted outcomes for all leads. " & _
" " & dblTotalUnactioned & strUnactionedSentence & " not submitted outcomes for all leads (cc'd) " & _
" " & _
"Progress Summary" & _
" " & _
" " & _
"<table border='1'><TBODY><tr><td>Relationship Manager<td>Total Leads</td><td>Total Actioned</td><td>Status</td></tr>"

'Create HTML table of summarised results and embed in email text
Set rst2 = CurrentDb.OpenRecordset("Select * from qryLeadsByRM where Area_Manager = '" & strRecipient & "' order by status desc")
With rst2
If rst2.RecordCount > 0 Then
rst2.MoveLast
rst2.MoveFirst
Do While Not rst2.EOF

If !Status = "Complete" Then
strStatus = "Complete"
Else:
If !Status = "Not Started" Then strStatus = "Not Started" Else strStatus = "In Progress"
End If

strMessage = strMessage & "<tr><td>" & !RM_Name & "</td><td>" & !total_leads & "</td><td>" & !actioned & "</td><td>" & strStatus & "</td></tr>"
rst2.MoveNext
Loop
End If
End With

rst2.Close
Set rst2 = Nothing

'Finish body to HTML email
'"Attached is a pivot chart providing more detail. " & _

strMessage = strMessage & "</TBODY></table>" & _
"* Data correct as at " & strLastLoadDate & _
" " & _
" " & _
"Attached is an Excel spreadsheet containing details of all leads provided." & _
" " & _
" " & _
strReminderMessage & _
" " & _
" " & _
"For more information about how to action leads in iKnow please refer to the following site: <A href =""" & " http://websitelink""" & ">Information</A>" & _
" " & _
" " & _
"If you have any questions please reply to this email. " & _
" " & _
"Regards, " & _
" " & _
"Signatory " & _
" " & _
"<hr></pre>"

This information is then passed to Outlook to send as an HTML email, you could equally save it as a webpage.

HTH.

James

Lensmeister · Oct 7, 2014

Cheers James. I'll have a play with a bit of a test database and see how it goes.

Mind you this email functionality may prove to also be helpful

spikepl · Oct 7, 2014

Before you embark on a major rewrite: whatever (with very few exceptions) you type on the command line you can trigger from Access using the Shell command - look it up in the docs! (Any file paths containing blanks need to be be wrapped in "") So yes, you can reuse your script
100%

Dim Ret as Integer

REet=Shell(MyStringWithCOmmandsLikeOnComamndLineButRemmebrQuotesForPaths, vbHide)

Jibbadiah · Oct 7, 2014

Yep, agree with spikepl. I like to have all the code in one place but rarely do I follow my own rules. Sounds like you'll do this in a recordset and create multiple pages. You may want to take a look at the code below if you are going to call external scripts.

Private Const sModule_Name As String = "ModRunDOSExecutable"
'The following is Code from Kris, a Software Engineer from Phoenix, AZ USA
'Additional code from Heulsa, Quebec/Canada
'Both came from Website: CodeGuru.com
'I have added my own changes so that it can be executed as a stand-alone function
'You would run code by calling the function like follows:
'RunDOSExecutable "c:\temp\Executable.bat", "c:\temp\Log.txt"

Option Explicit

'//public Constants
Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const INFINITE = -1&

'//public Types
Public Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Public Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type

'//API Declarations
Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long

Public Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal _
hObject As Long) As Long

Private Const STARTF_USESHOWWINDOW = 1
Private Const SW_HIDE = 0

Public Function RunDOSExecutable(AppToRun As String, Optional ByVal Logfile As String)
' AppToRun is used for DOS executable name, which must be a full path to Bat or Exe file
' Logfile is used to capture the outcome of running the executable
' The "/C" tells Windows to Run The Command then Terminate

PROC_DECLARATIONS:
Const sProc_Name As String = "RunDOSExecutable"
Dim cmdline As String

PROC_START:
On Error GoTo PROC_ERROR

PROC_MAIN:
'//Build Command string
If Logfile = "" Then
Else: Logfile = " > " & Logfile
End If

cmdline = AppToRun & " /C" & Logfile
DoCmd.Hourglass True

'//Shell App And Wait for It to Finish
ExecCmd cmdline, True
DoCmd.Hourglass False

PROC_EXIT:
' Perform cleanup code here, set recordsets to nothing, etc.
On Error Resume Next
Exit Function

PROC_ERROR:
Select Case iErrorHandler(Err.Description, Err.Number, sProc_Name, sModule_Name)
Case iERROR_DEBUG
Stop
Resume
Case iERROR_RETRY
Resume
Case iERROR_IGNORE
Resume Next
Case iERROR_ABORT
Call CloseApplication
Case Else

MsgBox "Error: " & Err.Description
End Select
Resume PROC_EXIT

End Function

Public Function ExecCmd(ByVal cmdline As String, Optional ByVal HideWindow As Boolean = False) As Long
PROC_DECLARATIONS:
Const sProc_Name As String = "ExecCmd"
Dim Proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ReturnValue As Integer

PROC_START:
On Error GoTo PROC_ERROR

PROC_MAIN:
If (HideWindow) Then
start.dwFlags = STARTF_USESHOWWINDOW
start.wShowWindow = SW_HIDE
End If

'//Initialize The STARTUPINFO Structure
start.cb = Len(start)

'//Start The Shelled Application
ReturnValue = CreateProcessA(0&, cmdline, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, Proc)

'//Wait for The Shelled Application to Finish
Do
ReturnValue = WaitForSingleObject(Proc.hProcess, 0)
DoEvents
Loop Until ReturnValue <> 258

'//Close Handle to Shelled Application
ReturnValue = CloseHandle(Proc.hProcess)

PROC_EXIT:
' Perform cleanup code here, set recordsets to nothing, etc.
On Error Resume Next
Exit Function

PROC_ERROR:
Select Case iErrorHandler(Err.Description, Err.Number, sProc_Name, sModule_Name)
Case iERROR_DEBUG
Stop
Resume
Case iERROR_RETRY
Resume
Case iERROR_IGNORE
Resume Next
Case iERROR_ABORT
Call CloseApplication
Case Else

MsgBox "Error: " & Err.Description
End Select
Resume PROC_EXIT

End Function

It used to work well for my purposes, otherwise you may end up with lots of scripts running simultaneously, or attempting to use your webpages when they aren't ready... maybe?! I'm a bit rusty!!

spikepl · Oct 7, 2014

Ahem .. all the above pain is justified if you need synchronous operations: i.e. need/want to wait for the code to finish prior to continuing with something.

The Shell command, on the other hand, goes off and does its thing but the code execution continues right away.

Jibbadiah · Oct 7, 2014

In my case I was using this code to winzip and password protect attachments for emails. 1400+ personalised email attachments for memory. His scenario sounds similar and if you are outputting a thousand webpages and sending them via sftp in the same code to your server then yes... you might need it. I'm not saying he does... but if... then great here it is, else ignore me. ;-)

Rx_ · Oct 7, 2014

While on the subject of Shell using vbs scripting:
We conducted a test a couple of weeks ago. Watching the Task Manager for an i7.
Access running a complex script seems to run in one processor thread.

Having the vba call 4 shells for vbs scripts, it appeared that each vbs scripting gets assigned to a new processor. That they run in parallel to the Access VBA.
As spikepl knowly commented, the Shell runs asynchronous. So, with great power of asynchronous comes the great pain of not having a clear response (return) when the shell process is completed.

Is there a good method for getting an asynchronous response, event or simulated return back to a VBA when calling vbs with shell to other call to a vbs script?

Calling the calc returns a value for example even if it is just that the appliation opened.
' Specifying 1 as the second argument
' opens the application in normal size and
' gives it the focus.
Dim RetVal
' Run Calculator.
RetVal = Shell("C:\WINDOWS\CALC.EXE", 1)

This isn't the Shell, but it appears to run a vbs script.

Code:

Option Explicit

Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Public Sub RunProgram()
'add a Reference to Windows Script Host Object Model in the Code window Tool - Reference
Dim wsh as New WshShell
Dim exec as WshExec
Set exec = wsh.Exec()
Call exec.StdIn.WriteLine("text to send to your program")
Do While exec.Status = WshRunning
Sleep 10
Loop
End Sub

It appears that only drawback to this method is that you cannot hide any windows created by the program you call, unlike Shell which you can pass the vbHide parameter.

I am just researching this for the tail end of my current project.

Lensmeister · Oct 8, 2014

Thanks for the assistance guys.

A bit advanced for me some of it.

I am going to have a play with the ideas over a few days and report back. Watch out for loads of dumb questions

Lensmeister · Oct 8, 2014

spikepl said:
Before you embark on a major rewrite: whatever (with very few exceptions) you type on the command line you can trigger from Access using the Shell command - look it up in the docs! (Any file paths containing blanks need to be be wrapped in "") So yes, you can reuse your script
100%

Dim Ret as Integer

REet=Shell(MyStringWithCOmmandsLikeOnComamndLineButRemmebrQuotesForPaths, vbHide)

So basicly I could have a form with command buttons on it and click one to execute the vbs to generate a particular webpage.

That sounds interesting.

My only problem is that my company may not allow vbs script to run, hince putting the code in an Access macro.

Can I use vbs script code like this? (1 Viewer)

Lensmeister

Registered User.

Lensmeister

Registered User.

Jibbadiah

James

Lensmeister

Registered User.

spikepl

Eledittingent Beliped

Jibbadiah

James

spikepl

Eledittingent Beliped

Jibbadiah

James

Rx_

Nothing In Moderation

Lensmeister

Registered User.

Lensmeister

Registered User.

Similar threads

Users who are viewing this thread