VBA Timing, to the Internet and Back 23apr09

[Neal Zimm]

Hi All,
Below are the final pieces of a Sub where user gets to a website to upload
a workbook.

My first time in getting to a website within VBA.

In testing, getting to the site in VBA works fine, BUT the last msgbox
displays before the work is done @ the site. I guess VBA does not
automatically wait until website call is exited to resume code execution.

I don't have a clue how I can "delay" test message two until the user
leaves the site and comes back to Excel(if such a thing is possible.)

Test message two does not rely on or need any info from the work done @
the Website.

Thanks, Neal Z

'Code starts

MsgBox "Test Message One"


Call Website_GoTo(sFindCd, AAscAddIn)

'key lines in above Website call
'If Not ParmCellRng Is Nothing Then
' ParmCellRng.Hyperlinks(1).Follow NewWindow:=True
'Else
' MsgBox sFindCd & " sFindCd for Website NOT FOUND. "
' End
'End If
'End Sub


MsgBox "Test Message Two"

End Sub

 

[joel]

Try adding the following:

DoEvents

The DoEvents will allow excel to break while an external event occurs like
getting the data from the website.

Usually I use code like this

'get web page
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop

Do While IE.busy = True
DoEvents
Loop

 

[Neal Zimm]

Joel -
Thanks for the answer, and there's a few follow up couple of questions
with the following background.

The code is part of an addin I'm building (on spec, I'm not an employee of
the company) where offices within a district upload a workbook to a website
and the district manager downloads, then summarizes them on the district
computer.

1. I can't really tell if your IE code is within my Website call, or
following it. Which is it? My guess is within.

2. I had thought about trying to automate the downloads to the district
computer, but after looking at the website's html source (about which I know
little, and I know nothing about xml) this function seemed well beyond my
ability to code. I figure since the overall flow of data will be much
speeded up that a manual download process is OK.
Your thoughts on the above?

3. Your example for IE raises this question, where do I find the info
about "readystate", if by chance the district office is using another
browser, like FireFox as I do?

thanks again,
Neal

 

[joel]

Belwo is a simple program I wrote for accessing the web. It uses the
DoEvents. the Internet Explorer Library functions are part of VBA language.
FireFox is not part of the VBA standard Library functions You would need a
addin to be able to use FireFox or use Shortcut Keys to access firefox. I
don't think you really want to use firefox because all your uses would need
to install FireFox to use your addin.

I don't recommend using Excel as a multi-user database. This is better done
with Access as the database and use Excel to upload and download data from
the database. Access is designed to allow multiple users to change data
simultaneously. Access has the preper locks to prevent the database from
getting corrupted or two users trying to write the same data at the same
time. Excel is more user friendly and is a good front end to the database.

All microsoft office products have the same file structure consisting of
documents, tables, graphs, pictures and these objects are stored exactlly the
same whether you use Access, Excel, power point, Visio. Only the application
is diferent and in VBA you can easily modifiy an Access macro to use in excel
with very minor changes.

You can acces Web data using the internet explorer code I provided, or
perform a webquery, or open an application (Access, or excel) conecting to
the database. You didn't say how the district manager is posting the data on
the web so I can't tell which is the best method. You also have the choice
of ADO or DAO access with a database. ADO and DAO can be used with excel
workbooks along with access databases. You can even read and write data to
an excel workbook without opening the workbook.

Sub GetZipCodes()


ZIPCODE = InputBox("Enter 5 digit zipcode : ")

Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True

URL = "http://zip4.usps.com/zip4/citytown_zip.jsp"

'get web page
IE.Navigate2 URL
Do While IE.readyState <> 4
DoEvents
Loop

Do While IE.busy = True
DoEvents
Loop
Set Form = IE.document.getElementsByTagname("Form")

Set zip5 = IE.document.getElementById("zip5")
zip5.Value = ZIPCODE


Set ZipCodebutton = Form(0).onsubmit

Form(0).submit
Do While IE.busy = True
DoEvents
Loop

Set Table = IE.document.getElementsByTagname("Table")
Location = Table(0).Rows(2).innertext
IE.Quit
MsgBox ("Zip code = " & ZIPCODE & " City/State = " & Location)


End Sub

 

[Neal Zimm]

Joel -
Again, many thanks for your response, and on a Sunday, too!

I will be learning Access soon, and converting the App may be worth the
effort. While trying to be brief, the overall application does not call for
shared access to the same data in a way where Access would be preferred over
what Excel can provide.

The business flow of the data requires that, should a district manager
need revisions from one of its offices, the office re-submits the data and a
re-summarization @ district level occurs after new workbooks are sent.

I appreciate the thought and time you put into this.

 

[joel]

the problem is if a bunch of users are reading the data the district manager
won't be able to save an updated file. How do you plan to do the submit.?

Here are 3 macros I wrote for somebody. the first Creates an Access
database from Excel VBA. The 2nd writes new data to the Aceess database
again from excel VBA. The 3rd creates a query for the users to read the
database. The query is setup to automatically update the query when the
workbook is opened.

the VBA code can easily be modified to run from either excel or access.

Public Const Folder = "C:\Temp\"
Public Const FName = "submission.mdb"
Sub MakeDataBase()

Const DB_Text As Long = 10
Const FldLen As Integer = 40


strDB = Folder & FName

If Dir(strDB) <> "" Then
MsgBox ("Database Exists - Exit Macro : " & strDB)
Exit Sub
End If

' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True


' Open database in Microsoft Access window.
appAccess.NewCurrentDatabase strDB
' Get Database object variable.
Set dbs = appAccess.CurrentDb
' Create new table.
Set tdf = dbs.CreateTableDef("Submissions")

' Create Task/ID field in new table.
Set fld = tdf. _
CreateField("Task_ID", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Client Name field in new table.
Set fld = tdf. _
CreateField("Client Name", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Effective Date field in new table.
Set fld = tdf. _
CreateField("Effective Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Imp Mgr field in new table.
Set fld = tdf. _
CreateField("Imp Mgr", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Due Date field in new table.
Set fld = tdf. _
CreateField("Due Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Actual Date field in new table.
Set fld = tdf. _
CreateField("Actual Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

' Create Date Difference field in new table.
Set fld = tdf. _
CreateField("Date Difference", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld

dbs.TableDefs.Append tdf

Set appAccess = Nothing


End Sub
------------------------------------------------------------------------------------------
Sub Submit()
'filename of database is with MakeDatabase macro

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

strDB = Folder & FName

If Dir(strDB) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strDB)
MsgBox ("Exiting Macro")
Exit Sub
End If

ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"

cn.Open (ConnectStr)
With rs
.Open Source:="Submissions", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

If .EOF <> True Then
.MoveLast
End If
End With

With Sheets("Internal Project Plan")

ClientName = .Range("B4")
ImpMgr = .Range("B5")
LaunchDate = .Range("C4")

LastRow = .Range("K" & Rows.Count).End(xlUp).Row
For RowCount = 7 To LastRow

If UCase(.Range("K" & RowCount)) = "X" Then

DueDate = .Range("E" & RowCount)
ActualDate = .Range("F" & RowCount)
DateDif = .Range("M" & RowCount)
Accurate = .Range("L" & RowCount)
Task_ID = .Range("B" & RowCount)

With rs
.AddNew
!Task_ID = Task_ID
![Client Name] = ClientName
![Effective Date] = LaunchDate
![Imp Mgr] = ImpMgr
![Due Date] = DueDate
![Actual Date] = ActualDate
![Date Difference] = DateDif

.Update
End With
End If
Next RowCount

End With

Set appAccess = Nothing
End Sub
-------------------------------------------------------------------------------------------
Public Const Folder = "C:\Temp"
Public Const FName = "submission.mdb"
Sub CreateQuery()
'
' Macro4 Macro
' Macro recorded 1/19/2009 by Joel
'
strDB = Folder & "\" & FName
'
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;" & _
"DBQ=" & strDB & ";" & _
"DefaultDir=" & Folder & ";" & _
"DriverId=25;" & _
"FIL=MS Access;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"), _
Array(";")), Destination:=Range("A1"))

.CommandText = Array( _
"SELECT Submissions.Task_ID," & _
"Submissions.`Client Name`," & _
"Submissions.`Effective Date`," & _
"Submissions.`Imp Mgr`," & _
"Submissions.`Due Date`," & _
"Submissions.`Actual Date`," & _
"Submissions.`Date Difference`" & _
Chr(13) & "" & Chr(10) & _
"FROM `C:\temp\submission`.Submissions Submissions")
.Name = "Query from MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
End Sub