End A Loop Macro At A Specific Row??

How Do I Run A Macro At A Specific Time
I am using MS ACCESS 2000 and want to have a SendObject macro run each day at midday, i have been told it is possible although i cannot find out how.

Any Ideas?

Regards
Matt

---

Run Macro At Specific Time
At 3:00pm daily, I want to output "DONE" in a specified cell. However, I cannot get the OnTime method to work automatically. Do I need to create an event? I have a subroutine that simply outputs done to a cell:

Sub fillCell
Range("E4").Value = "DONE"
End Sub

How do I run this automatically at 3pm? TIA.

---

Run Macro On Specific Day Of Week
looked everywhere for a simple solution... none to be found

Just want to do the following:


Code:
If Weekday = Saturday then...
'Run this code
End if

I have looked in MS Help, Mr. Excel, MSN.com & Here...Nothing
Any help would be appreciated
Thanks

---

Run Macro At Specific Time
Hi,

I was wondering if you can run macro's in excel automatically at a certain time?

Cheers

White Magic

---

Starting Macro When A Specific Value Changes
I want to start a macro when in a specific cell a value is entered or changed.
If tried this:

vb
Private Sub Worksheet_Change(ByVal Target As Range)

If Range("b27").Value > 0 Then
Call hydraulic_nut
End If

End Sub

Sub hydraulic_nut()
Dim S As String
S = WorksheetFunction.VLookup(Range("b27").Value, Sheets(3).Range("A2:B45"), 2, False)
Range("b28").Value = S
End Sub

vb
But the program gets very slow when i start an other macro (which put many results of the sheet)
What is the solution?

Maarten

---

Run Macro On Specific Cell Change
Is there a way to have a VB Macro run when a specific cell changes value ? I am able to have a macro run when a "sheet data change" takes place, but do not know how to isolate a specific cell to be watched, while ignoring any other changes to the sheet.

Thanks in advance for any help !!!

---

Running A Macro On A Specific DAY && Time
I know about the On Time Method... However can this method be modified to run on a specific Day as well as time...say Wednesday @ 3:00pm...Or is there another method that covers both Day & Time automation...

Thanks...

---

Not Linking A Macro To A Specific Workbook
I have created a few Macros but they are linked to the workbook. So stupid question, but how do I make it so that ANY time I open a workbook, the code can be run but not be directly linked to to a workbook. In other words, every month I receive a new workbook and I want to run a macro to clear a bunch of cells out (which works) but it always goes back to the original workbook.

Is there a place all my code should be? I have 2 macros saved in the toolbar and I wan to open ANY sheet and us the macro?


Edit by Moderator:
Please post Excel questions, in the Excel forum.

Thank you.

---

Connect Comandbutton To A Specific Macro?
How and where do I connect a command button to a recorded macro?

/G

---

Loop Through Controls In A Specific Order
I have multiple controls of several types on a userform. How do I loop through them (using the For Each control In Me.Controls) in a specific order?
By default, the order is determined by the chronological order the controls were created. How do I change this?

TIA.

---

Loop Trough Specific Textbox?
Hi
How do i loop trough a specific set of textbox for example from text5.text to text10.text whithout using control array?





Thanks

---

Macro To Delete Specific Text Box In PowerPoint
Hello, I have quite a few presentations, all which I didn't create, where some bright person manually put in page numbers in text boxes at the bottom of each slide instead of adding them in the footer. Is there anyway I can run a macro that will cycle throught the slides and delete them automatically? I have never even bothered with VBA in PowerPoint, mainly Excel and some Access, so I have no idea where to start.

I recorded a macro to try to grasp the syntax but like I said, I don't know what to do. (It always seems to name each text box "Rectangle 2")


ActiveWindow.Selection.SlideRange.Shapes("Rectangle 2").Select
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
ActiveWindow.Selection.ShapeRange.Delete


Any help on this would be great. I could manually delete them but there are at least 50 slides in multiple presentations.....absolutely ridiculous.

On a slide number note......I've searched the help files for this but someone might know it off hand. Is it possible to insert slide numbers after the presentation is created? I would think you'd be able to but I cannot.

Thanks.

---

Use Macro To Find A Specific Word In Excel
Hi all,

I need the help as currently i have created a vb program which link to excel worksheet. The program has to search for example "FREIGHT" word in EXCEL column B. If the column B has such "FREIGHT" wording, the program should stamp "FOUND" in column C else nothing will stamp in column c.
I can use below script to find the "FREIGHT", but my question is how to set "FOUND" in column C if the "FREIGHT" wording is found in column b? Anybody got any clue on it ?

ExcelSheet.Columns.Find(What:="FREIGHT", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate

Please help!
Thanks!

From,
Siaw Ch'ng

---

Firing A Macro On Selecting Specific Sheet
The subject says it all really.

How can I get Excel to fire a macro when one of the sheets in my workbook is selected?

Thanks

Francis Neil Beans

---

Trying To Get Loop To Delete Specific Items From Combobox
Hi all,

I have a database that track employees' schedules in half hour increments, using military time format (02:00, 02:30, 03:00, and so on).

What I want to do is execute code that goes back and checks the database for appointments, and if it finds one, takes the start time, adds 90 minutes for a total of a 2 block. Then it deletes that 2 hour block from the combo box that contains available times for other appointments.

The loops work, i have tested those with message boxes. What happens is that the times with XX:30 are removed, but not XX:00 times.

Here's what I have:


Code:
If rs.RecordCount <> 0 Then
ConflictTime = rs.Fields("Time")
EndConflictTime = Format(DateAdd("n", 90, ConflictTime), "hh:mm")
i = 0
Do Until i = cboTime.ListCount
cboTime.ListIndex = i
Do
If cboTime.text = ConflictTime Then
cboTime.RemoveItem cboTime.ListIndex
End If
ConflictTime = Format(DatAdd("n", 30, ConflictTime), "hh:mm")
Loop Until ConflictTime = EndConflictTime
i = i + 1
Loop
End If
Any help is appreciated. Thanks!

---

Need To Loop Thru Records To Identify Specific Situation
I have a table with the following fields:

CONTAINER NUMBER - 1 container no. can have several CS no.s
CS NUMBER - several CS no.s can belong to one container
Size
Type
ETD
ETA
etc...

I need to determine 3 things, first, I need to identify all containers where any of the size, type, etd. data is different across CS No.s on the same container.  Additionally, I need to know what field contains the different values.  Lastly, I need to quantify how many times a specific field shows up meeting the above criteria.

Please help me to get started.

---

To Connect An Indiv. Filetype/extension With A Specific Macro
Hello Experts,

how can I manage that WIN-XP opens a specific EXCEL-Workbook if I double-click on a file with an extension "created" by myself. The called EXCEL-Macro embedded in the Workbook shall know where to find this file and open/read it. I know where to tell WIN-XP the link between filetype and application. But how to define an EXCEL-Worbook as "application" in this meaning?

Thanks for help,

Johannes

---

Macro For Excel To Copy Data To Specific Worksheet - Help!
I need help creating a macro for Excel. My workbook has 13 worksheets in it. The first worksheet is for data entry - where the user types in the call information. Each of the other 12 worksheets are labeled by month. What I want is a macro that will copy the row of data (record) onto the corresponding month's worksheet.

For example, a call comes in on January 3, 2002. The employee puts in the date of the call, the problem and the solution in adjacent cells in the same row. I want a Macro to automatically copy that row's data onto the January worksheet, in the first empty row.

Any ideas?
Thanks!
Beth

---

Use Excel Macro To Delete Rows With Specific Data In Cells
I need some help writing a macro that deletes a row (or number of rows) in a worksheet. We have an appointment scheduling app that exports the data in .CSV format. I run a macro that formats this .CSV file so we can insert it into another .XLS sheet that gets emailed to our retail locations to post their daily appointments. What I would like to automate is removing multiple rows that have N A in the firstname & lastname columns. Is there someway to "delete any row that has N in column c and A in column d"? We use the N A as fake names to fill in time slots we don't want to make "real" appointments. Now I have those times blocked out and have to manually delete each one before copying into the formatted worksheet that's mailed to the individual stores. Thanks for any and all help! TommyT.

---

Loop Macro
Hi all,

I'm new here and I'm looking for some help.

I'm trying to build a macro that will go through a 1200 page document searching for a specific name with a value. Then that will be copied to another document.

I got round doing the search, copy and paste part but I'm having a problem doing the loop untill the end of the document.

I have searched many places but I cant find how to stop the loop when it reaches the end of the document or by reaching a specific page.

Can anyone help me please.

Thanks.

---

Basic VB Macro Loop For Pasting Screen Shots
I am very new to VB and know a little bit about macros.
I want to automate the pasting of screen shots from a program to MS power point and then create a new slide. To which the paste function happens again.
I have copied the original recorded macro, how do I create a loop of this for say 25 steps (can this number be made a variable).

Sub Macro2()
'
' Macro recorded 1/11/2005 by me
'

ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=4, Layout:=ppLayoutBlank).SlideIndex
ActiveWindow.View.Paste
End Sub

Cheers

---

Import External Data Via Loop Macro Query
Hi
I have developed a macro to import data from another set of workbooks, to allow a comparison in one workbook, based upon cell references that loops until it hits a blank cell but have 2 problems I cannot fix as follows:
1. Data is copied into spreadsheet without any of the original formatting. I want to keep the items that are boldened, or bordered etc.
2. When I save the file as a template file the macro stops working and says it cannot find the destination file. I'm guessing this is due to it being a template and not an xls file????
Macro is as follows, any help much appreciated as I am so close!

A

B C D
1 Copy From WB

Copy From Range

Copy To WB

Copy To Range
2 f: esta.xls

Sheet1!A1:A5

f: estSummary.xls Sheet2!B1
3 f: est.xls

Sheet1!A1:A6

f: estSummary.xls Sheet2!C1
4 f: estc.xls

Sheet1!A1:A7

f: estSummary.xls Sheet2!D1
5 f: estd.xls

Sheet1!A1:A8

f: estSummary.xls Sheet2!E1
Sheet1

Code:
Option Explicit
Const msParameterSheet As String = "Sheet1"
Const miWBFromCol As Integer = 1
Const miCopyFromCol As Integer = 2
Const miWBToCol As Integer = 3
Const miCopyToCol As Integer = 4
Sub Test()
Dim bFail As Boolean
Dim lRow As Long
Dim rFrom As Range, rTo As Range
Dim sCurWB As String, sTargetWB As String, sPrevTargetWB As String
Dim sCopyFrom() As String, sCopyFromRange As String
Dim sCopyTo() As String, sCopyToRange As String
Dim sAdd1 As String, sAdd2 As String
Dim vaData As Variant
Dim wbTarget As Workbook
Dim wsParamSheet As Worksheet, wsCurFrom As Worksheet, wsCurTo As Worksheet
Set wsParamSheet = Sheets(msParameterSheet)
'-- Get last row of data --
lRow = wsParamSheet.Range("A" & Rows.Count).End(xlUp).Row
'-- Store parameters into array --
vaData = wsParamSheet.Range("A1:D" & lRow).Value
sPrevTargetWB = &H0
'loop thru data, ignoring row 1 --
Application.EnableEvents = False
For lRow = 2 To UBound(vaData, 1)

bFail = False

'-- Open target workbook if required --

sTargetWB = CStr(vaData(lRow, miWBToCol))

If LCase$(sTargetWB) <> sPrevTargetWB Then

sPrevTargetWB = LCase$(sTargetWB)

If Not (wbTarget Is Nothing) Then

With Application

.DisplayAlerts = False

wbTarget.Close savechanges:=True

.DisplayAlerts = True

End With

End If

On Error Resume Next

Workbooks.Open Filename:=sTargetWB

If Err.Number <> 0 Then

MsgBox Err.Number

bFail = True

End If
'

bFail = Err.Number <> 0

On Error GoTo 0

If bFail Then

MsgBox "Unable to open workbook " & sTargetWB

Else

Set wbTarget = ActiveWorkbook

End If

End If

'-- Open 'Copy From' WB --

If bFail = False Then

sCurWB = CStr(vaData(lRow, miWBFromCol))

On Error Resume Next

Workbooks.Open Filename:=sCurWB, ReadOnly:=True

bFail = Err.Number <> 0

If bFail Then MsgBox "Failed to open " & sCurWB

End If

'-- Process 'Copy From' Range --

If bFail = False Then

'-- Set worksheet & From Range

bFail = ProcessCopyRange(RangeDefinition:=CStr(vaData(lRow, miCopyFromCol)), _

WB:=ActiveWorkbook, _

WS:=wsCurFrom, _

Rangex:=rFrom)

If bFail Then MsgBox "'Copy From' field invalid for workbook " & sCurWB

End If

'-- Process 'Copy To' Range --

If bFail = False Then

bFail = ProcessCopyRange(RangeDefinition:=CStr(vaData(lRow, miCopyToCol)), _

WB:=wbTarget, _

WS:=wsCurTo, _

Rangex:=rTo)

sCopyTo = Split(CStr(vaData(lRow, miCopyToCol)), "!")

bFail = UBound(sCopyTo) <> 1

If bFail Then MsgBox "'Copy To' field invalid for workbook " & sCurWB

End If

If bFail = False Then

'-- Do the copy --

sAdd1 = Cells(rTo.Row, rTo.Column).Address

sAdd2 = Cells(rTo.Row + rFrom.Rows.Count - 1, _

rTo.Column + rFrom.Columns.Count - 1).Address

wsCurTo.Range(sAdd1, sAdd2).Value = rFrom.Value

ActiveWorkbook.Close

Else

Exit For

End If
Next lRow
Application.EnableEvents = True
End Sub
Private Function ProcessCopyRange(ByVal RangeDefinition As String, _

ByVal WB As Workbook, _

ByRef WS As Worksheet, _

ByRef Rangex As Range) As Boolean
Dim bFail As Boolean
Dim saRangeDef() As String
saRangeDef = Split(RangeDefinition, "!")

---

Macro Works 1 Loop At A Time, But Stalls If Run Start-to-finish
Hi.

I've got this complex macro that WAS working perfectly but now stalls each time I run it. The annoying thing is that the code DOES work: if I insert a breakpoint over the "Next" statement (or even at the "Save") and only let it run one full loop at a time, then it works just fine and will run to completion (so long as I'm patient enough to loop it through by hand over & over). But since I need this thing to loop 73 times each time I run it (and each of those loops involves doing thousands of smaller loops), I'd rather find out what's going wrong & fix it, instead of spending my whole summer looping it all by hand..
So here's the code (including all the lead-in bits so you'll have as much info as possible):

Code:
Option Explicit
Option Base 1
Public SourceFile As Variant, SummaryFile As Workbook, Response, ResponseBool As Boolean, Row As Long
Public Sub SummariseBlossom()
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder") 'otherwise it's slow
If Response = vbNo Then
Exit Sub
Else
ResponseBool = True
Call ImportAndReformat
Call SummarisingResults
Set SummaryFile = Nothing
End If
MsgBox "All Done!"
End Sub

Private Sub ImportAndReformat()
Dim ResultStr As String, sFileName As String, FileNum As Integer, Counter As Double, FileNameArr As Variant
Dim ResultsWB As Workbook, Response As Integer, lngCount As Long, NextResponse, shtCount As Double
Dim Rng As Range, WS As Worksheet, c As Range, SummaryWB As Workbook, ssCount As Double
Dim FirstAddress As String, MyArr As Variant, Rcount As Long, i As Long, AllCaps As String
Dim l As Long, lStart As String, Skip As Long, pos As Long, f As Long
Dim SUBFileNum As Integer, SourceStr As String, SUBSource As String, SUBFile As Variant, SUBHyp As String, Hyp As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
If ResponseBool = False Then
Response = MsgBox("Have you remembered to close all open workbooks and programs (except for Excel)??", vbYesNo, "Reminder")
If Not Response = vbYes Then
Exit Sub
End If
End If
ChDir "C:Results"
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Add "Blossom Output", "*.txt", 1
.Filters.Add "All Files", "*.*"
.Title = "Choose which T-Statistic Source File(s) to summarise"
.Show
End With
FileNum = FreeFile()
ssCount = 0
Set SummaryFile = Workbooks.Add(template:=xlWorksheet)
SummaryFile.Activate
SummaryFile.SaveAs Filename:=Application.GetSaveAsFilename(SourceFile, "Excel Workbooks(*.xls), *.xls", _
, "Choose a one-word name for the Summary workbook")

'***************HERE'S WHERE THE TROUBLESOME LOOP STARTS:***********
For f = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
SourceFile = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(f)
FileNameArr = Split(CStr(SourceFile), "", 7)
shtCount = 1
Open SourceFile For Input As #FileNum
If Not f = 1 Then
SummaryFile.Worksheets.Add After:=Worksheets(Worksheets.Count)
End If

SummaryFile.Worksheets(Worksheets.Count).Name = "T_File" & f
Counter = 1
Do While Seek(FileNum) <= LOF(FileNum)
Application.StatusBar = "Importing Row " & Counter & " of output file " & SourceFile
Line Input #FileNum, ResultStr
If Left$(UCase(ResultStr), 2) Like Left$(UCase(FileNameArr(UBound(FileNameArr) - 1)), 2) Then
Row = 1
If Not ActiveCell.Address = "$A$1" Then
ActiveCell.Offset(1 - ActiveCell.Row, 1).Select
If ActiveCell.Column = 220 Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Range(Cells(1, 1), Cells(1, 251)).Font.Bold = True
shtCount = shtCount + 1
Worksheets(Worksheets.Count).Name = "T_File" & f & "#" & shtCount
Cells(1, 1).Select
End If
End If
ssCount = ssCount + 1
ActiveCell.Value = "ss" & ssCount
Else
Row = Row + 1
ActiveCell.Value = ResultStr
End If

ActiveCell.Offset(1, 0).Select
Counter = Counter + 1
Loop
Close
Next f '<=== CODE WORKS FINE IF BREAKPOINT IS PUT HERE!!
SummaryFile.Save '<=== OR EVEN HERE
'...the macro carries on - but that part works a-ok
Can anyone see why this is stalling? I've run out of ideas & can't even debug b/c the code DOES officially work...

Hope someone can help... Thx

---

How To Access A Specific Link On A Specific Frame With WebBrowser Control?
Using WebBrowser control(or equivalent code) I want to access science.cgi from the side frame of a page with this source code:

Main Page:

Code:<HTML><HEAD><TITLE>The World of Legends</TITLE></HEAD>
<FRAMESET COLS=100,*>
<FRAME NAME=links SRC="links/side.htm?rc=467228" MARGINWIDTH=0 MARGINHEIGHT=0>
<FRAMESET ROWS=25,*>
<FRAMESET COLS=*,275>
<FRAME NAME=freebies SRC="links/top.htm?rc=283268" NORESIZE MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
<FRAME NAME=adlink SRC="http://misc.swirve.com/adframe.cgi?server=u1.swirve.com&cid=1" NORESIZE MARGINWIDTH=0 MARGINHEIGHT=0 SCROLLING=NO>
</FRAMESET>
<FRAME NAME=utomain SRC="menu.cgi?entergame=yes&ad=true&rc=6754842" NORESIZE MARGINWIDTH=0 MARGINHEIGHT=0>
</FRAMESET>
<NOFRAMES>Utopia requires a frames-capable browser. Almost every
modern browser includes frame support, so you may wish to try upgrading
to a browser such as Netscape or Internet Explorer.</NOFRAMES></FRAMESET>
Utopia requires a frames-capable browser. Almost every modern browser
includes frame support, so you may wish to try upgrading to a browser
such as Netscape or Internet Explorer.
</BODY></HTML>


Side Frame:

Code:<HTML>
<HEAD>
</HEAD>
<BODY BGCOLOR=#000000 TEXT=#FFFFFF LINK=#FFFFFF VLINK=#FFFFFF leftmargin=0 topmargin=0 marginwidth=0 marginheight=0>
<IMG SRC="http://207.200.11.37/utopia/gr/uttitle.gif" WIDTH=80 HEIGHT=30 BORDER=0><FONT SIZE=-1>
<MAP NAME=menu>
<AREA SHAPE=rect TARGET=utomain HREF="/menu.cgi?" COORDS=1,3,80,15>
<AREA SHAPE=rect TARGET=utomain HREF="/council.cgi?" COORDS=1,16,80,28>
<AREA SHAPE=rect TARGET=utomain HREF="/explore.cgi?" COORDS=1,42,80,54>
<AREA SHAPE=rect TARGET=utomain HREF="/build.cgi?" COORDS=1,55,80,67>
<AREA SHAPE=rect TARGET=utomain HREF="/science.cgi?" COORDS=1,68,80,80>
<AREA SHAPE=rect TARGET=utomain HREF="/military.cgi?" COORDS=1,81,80,93>
<AREA SHAPE=rect TARGET=utomain HREF="/magic.cgi?" COORDS=1,107,80,119>
<AREA SHAPE=rect TARGET=utomain HREF="/thievery.cgi?" COORDS=1,120,80,132>
<AREA SHAPE=rect TARGET=utomain HREF="/attack.cgi?" COORDS=1,133,80,145>
<AREA SHAPE=rect TARGET=utomain HREF="/aid.cgi?" COORDS=1,146,80,158>
<AREA SHAPE=rect TARGET=utomain HREF="/readmsg.cgi?" COORDS=1,172,80,184>
<AREA SHAPE=rect TARGET=utomain HREF="/msg.cgi?" COORDS=1,185,80,197>
<AREA SHAPE=rect TARGET=utomain HREF="/forum.cgi?" COORDS=1,198,80,210>
<AREA SHAPE=rect TARGET=utomain HREF="/politics.cgi?" COORDS=1,211,80,223>
<AREA SHAPE=rect TARGET=utomain HREF="/status.cgi?" COORDS=1,224,80,236>
<AREA SHAPE=rect TARGET=utomain HREF="/scores.cgi?" COORDS=1,250,80,262>
<AREA SHAPE=rect TARGET=utomain HREF="/leaders.cgi?" COORDS=1,263,80,275>
<AREA SHAPE=rect TARGET=utomain HREF="/news.cgi?" COORDS=1,276,80,288>
<AREA SHAPE=rect TARGET=utomain HREF="/news.cgi?yesterday=true?" COORDS=1,289,80,301>
<AREA SHAPE=rect TARGET=utomain HREF="/dragon.cgi?" COORDS=1,302,80,314>
<AREA SHAPE=rect TARGET=utomain HREF="/pref.cgi?" COORDS=1,328,80,340>
<AREA SHAPE=rect TARGET=_blank HREF="http://games.swirve.com/utopia/help" COORDS=1,341,80,353>
<AREA SHAPE=rect TARGET=utomain HREF="http://games.swirve.com/utopia/help/faq.htm" COORDS=1,354,80,366>
<AREA SHAPE=rect TARGET=_top HREF="/logout.cgi?" COORDS=1,370,80,385>
</MAP>
<CENTER><IMG SRC="http://207.200.11.37/utopia/gr/newmenu.gif" USEMAP="#menu" HEIGHT=385 WIDTH=80 BORDER=0>
<a href="sidenogr.htm"><font size=1 face=verdana><B>No Graphics</B></FONT></A>
</BODY></HTML>


It must be accessed from the site, since it gives me a "You cannot access this page from outside the site" error.
However, I can click the last link of the side frame to open a page with this source:

Code:<HTML>
<HEAD>
</HEAD>
<BODY BGCOLOR=#000000 TEXT=#FFFFFF LINK=#FFFFFF VLINK=#FFFFFF leftmargin=0 topmargin=0 marginwidth=0 marginheight=0>
<IMG SRC="http://games.swirve.com/utopia/gr/uttitle.gif" WIDTH=80 HEIGHT=30 BORDER=0><FONT SIZE=-1>
<FONT SIZE=1 face=verdana>
<BR>
<A HREF="/menu.cgi?" TARGET=utomain>Menu</A><BR>
<A HREF="/council.cgi?" TARGET=utomain>Council</A><BR>
<BR>
<A HREF="/explore.cgi?" TARGET=utomain>Explore</A><BR>
<A HREF="/build.cgi?" TARGET=utomain>Growth</A><BR>
<A HREF="/science.cgi?" TARGET=utomain>Sciences</A><BR>
<A HREF="/military.cgi?" TARGET=utomain>Military</A><BR>
<BR>
<A HREF="/magic.cgi?" TARGET=utomain>Mystics</A><BR>
<A HREF="/thievery.cgi?" TARGET=utomain>Thievery</A><BR>
<A HREF="/attack.cgi?" TARGET=utomain>War Room</A><BR>
<A HREF="/aid.cgi?" TARGET=utomain>Send Aid</A><BR>
<BR>
<A HREF="/readmsg.cgi?" TARGET=utomain>Read Msgs</A><BR>
<A HREF="/msg.cgi?" TARGET=utomain>Send Msgs</A><BR>
<A HREF="/forum.cgi?" TARGET=utomain>Forums</A><BR>
<A HREF="/politics.cgi?" TARGET=utomain>Politics</A><BR>
<A HREF="/status.cgi?" TARGET=utomain>Relations</A><BR>
<A HREF="/dragon.cgi?" TARGET=utomain>Dragons</A><BR>
<BR>
<A HREF="/scores.cgi?" TARGET=utomain>The Kingdom</A><BR>
<A HREF="/leaders.cgi?" TARGET=utomain>The World</A><BR>
<A HREF="/news.cgi?" TARGET=utomain>The Paper</A><BR>
<A HREF="/news.cgi?yesterday=true?rc=978902?" TARGET=utomain>Last Month</A><BR>
<BR>
<A HREF="/dragon.cgi?" TARGET=utomain>Dragons</A><BR>
<A HREF="/defect.cgi?" TARGET=utomain>Defect</A><BR>
<A HREF="/pref.cgi?" TARGET=utomain>Preferences</A><BR>

<A HREF="/logout.cgi?" TARGET=_top>Log Out</A><BR>
<A HREF="side.htm?">Graphics On</A><BR>
</BODY></HTML>


The code I have been using so far in my program(for filling text boxes) looks like this:

Code:Private Sub Com1_Action()

Dim htmlSearchButton As HTMLButtonElement

Set docCurrentHTML = WebBrowser1.document.documentElement.All

For Each Item In docCurrentHTML

If Item.tagName = "INPUT" Then
If Item.Name = "Username" Then
Item.Value = Text1.Text
Exit For
End If
End If

Next Item

Any help would be nice!

---

How To Use Timer Control To Perform Specific Task At Specific Time Of The Day
How can I use timer control if I want to send a file through email everyday at 9 am. here is the code I am trying to implement:
Private Sub tmrSaleCode_Timer()
'MyTime = TimeSerial(10, 19, 0)

If Start1 = 0 Then
Start1 = Timer
End If
Pause = 86400
'Pause1 = 1000
If Timer &lt; Start1 Then
Start1 = Timer
End If
If Timer &gt; (Start1 + Pause1) Then
'If MyTime = Time Then
Start1 = Timer

Module1.TestSndMail
Label2.Caption = "Last Update = " & Now()
'Else
' Start1 = Timer
'End If
End If

End Sub
Thanks.

---

Shell To Open Specific File From Specific Program
shell can open MS Word like so:

MyAppID = Shell("C:WORDWINWORD.EXE", 1)

But I want to open a specific file.

How?

Thanx in advance.

Rami

---

How To Read A Specific Http Link On A Specific Page And..
Hello ppl!
I am a REAL newbie to VB and I am trying to do a simple thing (I hope) I have no real basecode just the one to open a specific link: Code:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Sub Form_Load()

    ShellExecute 0, vbNullString, "http://play.mp3.com/cgi-bin/play/play.cgi/AAIBQgAAAADABG5vcm1QBAAAAFLeTgEAUQoAAABYAQAAAFneTgEAQ2.J0TwUhHw6YJu97A3gU7XcOVum/fuzytoes.m3u/", vbNullString, vbNullString, vbNormalFocus
Unload Me

End Sub
Now, Id like to add some functionality since MP3.com changes the links every now and then. I need the program to go to the page, snatch the new link and then use it to open, say winamp. BTW, IE 5.5 does not alway's respond to the code above.. Dunno why. Sometimes it does. sometimes nothing happends whatsoever. Strange!

Ideas? Perhaps not a whole solution cause then I'll not learn. Thanx in advance! /FuzyToes

---

Copy Specific Files To Specific Folder
Hi,

i have several files in one folder.
For example 111.mp3, 222.mp3, 333.mp3

On a different folder with the name mp3 i got subfolders
with names 111 and 222 and 333

now i want to check each file in the folder if the files name equals the folder name in the subfolders. if it equals the name, copy the file to the folder.
for example
111.mp3 to folder 111

I have no glue how this works.

can anyone please help me??

thx,

akim123

---

Put Specific Character In A Specific Part Of String
Hi,

I am making a hangman game. Near the bottom of my code you will see that A Do loop. What I want to know is, is there a function that allows me to put a letter in a specific part of a string. As you can see, I ahve found the position of the letter clicked. I just need to put it in the correct place.

Can you help me?


Code:
Private strLetter As String
Public strWord As String
Public intCount As Integer

Private Sub cmdA_Click()
strLetter = "A"
cmdA.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdB_Click()
strLetter = "B"
cmdB.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdC_Click()
strLetter = "C"
cmdC.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdD_Click()
strLetter = "D"
cmdD.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdE_Click()
strLetter = "E"
cmdE.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdF_Click()
strLetter = "F"
cmdF.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdG_Click()
strLetter = "G"
cmdG.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdGuess_Click()
Dim strAnswer As String

If UCase(InputBox("Please enter your guess")) = strWord Then
MsgBox ("CONGRATULATIONS! You are Correct!")
picOut.Picture strWord
Else
MsgBox ("SORRY! You are Incorrect")
End If

End Sub

Private Sub cmdH_Click()
strLetter = "H"
cmdH.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdI_Click()
strLetter = "I"
cmdI.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdJ_Click()
strLetter = "J"
cmdJ.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdK_Click()
strLetter = "K"
cmdK.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdL_Click()
strLetter = "L"
cmdL.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdM_Click()
strLetter = "M"
cmdM.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdN_Click()
strLetter = "N"
cmdN.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdO_Click()
strLetter = "O"
cmdO.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdP_Click()
strLetter = "P"
cmdP.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdPlay_Click()
frmHangMan.Form_Activate
End Sub

Private Sub cmdQ_Click()
strLetter = "Q"
cmdQ.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdR_Click()
strLetter = "R"
cmdR.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdS_Click()
strLetter = "S"
cmdS.Enabled = False
intCount = intCount + 1

Call placeLetter(strLetter)
End Sub

Private Sub cmdT_Click()
strLetter = "T"
cmdT.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdU_Click()
strLetter = "U"
cmdU.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdV_Click()
strLetter = "V"
cmdV.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdW_Click()
strLetter = "W"
cmdW.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdX_Click()
strLetter = "X"
cmdX.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdY_Click()
strLetter = "Y"
cmdY.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdZ_Click()
strLetter = "Z"
cmdZ.Enabled = False
intCount = intCount + 1
Call placeLetter(strLetter)
End Sub

Private Sub cmdExit_Click()
End
End Sub

Public Sub Form_Activate()

picOut.Cls

Dim intWord As String
Dim intLength As String
Dim strLetters As String
Dim strBar As String

Randomize

intWord = Int(Rnd * 20) + 1

Select Case intWord
Case 1
strWord = "TRANSPORTATION"
Case 2
strWord = "COMPUTERS"
Case 3
strWord = "ONTARIO"
Case 4
strWord = "BASKETBALL"
Case 5
strWord = "EATING"
Case 6
strWord = "SHIRT"
Case 7
strWord = "CARPRT"
Case 8
strWord = "CRICKET"
Case 9
strWord = "FIXED"
Case 10
strWord = "DRIVING"
Case 11
strWord = "OUTSTANDING"
Case 12
strWord = "ASSIGNMENT"
Case 13
strWord = "WINDOW"
Case 14
strWord = "COLOUR"
Case 15
strWord = "HOLIDAY"
Case 16
strWord = "KEYBOARD"
Case 17
strWord = "PRESENTATION"
Case 18
strWord = "BILLIARDS"
Case 19
strWord = "CALENDER"
Case 20
strWord = "BACKPACK"
End Select


For i = 1 To Len(strWord)

picOut.Print "_ ";
Next i
End Sub

Private Sub placeLetter(strLetters As String)
Dim intLength As Integer
Dim strOneLetter As String
Dim strSeason As String, strSubString As String, strPlaceLetter As String
Dim intAnswer As Integer

intLength = Len(strWord)

Do Until intCount = 5
intAnswer = InStr(1, strWord, strLetters)

If intAnswer = 0 Then

Exit Do
Else

picOut.Print strLetters
End If
Loop

If intCount = 5 Then
MsgBox ("Sorry! Out of Guesses!")
End If

End Sub

---

Listbox : Do Specific Things On Specific Items
hi, i hope anyone can help me out, my problem is simple, as usual. :-)
lol

I have a Listbox, and in the listbox there 3 items (for example):
1) Dog
2) Cat 1
3) Cat 2

When I click on Dog, it'll show a MsgBox
When I click on other items, it'll.... hmm...close the program

How do i do that?

---

Add Data To A Specific Field From Specific Record
what's the part i'm missing or doing wrong! can you have a look?
thank's


Dim LOTeliminA As String
LOTeliminA = "SELECT TAULA_BASE.*, IDENTIFICADOR AS expr1 FROM TAULA_BASE where ( IDENTIFICADOR = '" & CBOaNULARlOTS.Text & "')"

Dim CONEXioLOTeliminA As ADODB.Connection
Set CONEXioLOTeliminA = New ADODB.Connection
CONEXioLOTeliminA.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "Porci_Lots.mdb;" & "Persist Security Info=False"

Dim recordSetLotElimina As ADODB.Recordset
Set recordSetLotElimina = New ADODB.Recordset
recordSetLotElimina.CursorLocation = adUseClient
recordSetLotElimina.Open LOTeliminA, CONEXioLOTeliminA, adOpenKeyset, adLockOptimistic '


With recordSetLotElimina
'.AddNew
.Fields("motiu_baixa") = Me.TXTmotiuBaixa.Text
'.Update
End With

Set recordSetLotElimina = Nothing
Set CONEXioLOTeliminA = Nothing

---

Assign Specific Icon To Specific Extention?
hi
how can you specify a specific icon to a specific extention
e.g if your file extention is jkl(123.jkl) how can you assign a specific icon to these files
i want to make my own ext (files having ext) and want to assign a specific icon to them

---

Running A Specific Task At Specific Time Of The Day
I am trying to write a program using Timer function and Timer control. I have to send a file everyday through email at 9 am. I do have the code which looks like this:

Private Sub tmrSaleCode_Timer()
'MyTime = TimeSerial(10, 19, 0)

If Start1 = 0 Then
Start1 = Timer
End If
Pause = 86400
'Pause1 = 1000
If Timer &lt; Start1 Then
Start1 = Timer
End If
If Timer &gt; (Start1 + Pause1) Then
'If MyTime = Time Then
Start1 = Timer

Module1.TestSndMail
Label2.Caption = "Last Update = " & Now()
'Else
' Start1 = Timer
'End If
End If

End Sub

How can I change this to make it work?

---

Getting A Specific Field Value From A Specific Record (DAO)
Thanks Beacon and Honeybee
One other thing: What should I use to get the total number of records? Is that "Data1.RecordSet.RecordCount" or "Data1.RecordSet.RecordCount+1"?

---

Word Macro Insert File/ Append Table Macro Issue.
Hello,

I was wondering if someone could help me with this problem...

When I use the following code to insert a table (from an external file), the table that is inserted does not append to the table in first document (which is what I want it to do)...

Sub Macro1()

Selection.Collapse Direction:=wdCollapseEnd
Selection.InsertFile FileName:="m:cat.DOC", Link:=True

End Sub

Would anyone know how I can make the contents of this file append to the table in the first document?

Thanks so much in advance,

Anne

---

Macro Opens A Document In Vba, Saves, Then Continue With Macro
Maybe the title isn't correct, but i've got the following problem.
I build a document that open a form. On this form there is a checkbox. When the checkbox is active and I press 'OK' a document has to be opened. On this document some changes can be made, then by pressing 'continue' this document is saved on 'c: emp' and closed. Then I want to go back to the first document and continue with it.
Is there some sort of halt or wait funtion to establish this?

The code I use is the following:

<code document1>
If chbFinPar = True Then
Documents.Open FileName:="f:Nieuwe format macroHuisstijlTestversiefinpar.doc"
Selection.EndKey , ActiveDocument.Bookmarks("bmkfinpar").Range
Selection.InsertFile FileName:="c: empfinpar.doc"
End If
<end code>

<code document2>
Private Sub cmdVrdr_Click()
ActiveDocument.SaveAs ("c: empfinpar.doc")
ActiveDocument.Close
End Sub
<end code>

---

Word Macro Editor Opens When I Misspell A Macro Name
I'm using Word 2000, and pressing Alt+F8 to access macros - just text strings - and here's the trouble:

I'm trying to make it possible for everyone here to use Word macros from the server. I've put a file out there called Macros.dot and it works great. Every machine in the building can see it and use it. Trouble is, if a user misspells a macro name the macro editor opens by default. It doesn't realize the user has misspelled something and thinks the user wants to write a new macro under the "new" name. User can click the X to close the editor, of course, but has now created a blank macro with a name very similar to a real macro. This will drive people (especially the less tech savvy) nuts, and clog up the file Macros.dot with garbage.

Is there a way to disable the macro editor from opening if an incorrect (nonexistent) macro name is typed? A check box somewhere, perhaps? I've tried but can't seem to find it, if it's there.

Thanks

---

Openning Excel And Running Macro From Word - Macro
Ok - I have a DB which I export to Excel, I then run a macro to "Groom The Data". I then run word and run a Macro (MailMerge to print labels) which retrieves data from the excel spreadsheet groomed above. Everything is working fine, despite my novice knowledge of VB, but I would like to do this in a single click.

I use a command line shortcut to Launch word and automatically have it run the macro, but I still have to Launch Excel and manually run its macro first.

I did not find a command line switch to make excel launch and run a macro. Is there any way I can Lauch Word have its Macro link to excel, then launch and run the excel macros before performing the macro I have set up in word (mailmerge)

In Other Words I have working macros in Word and Excel, I want the Word Macro to force the Excel macro to run before completing the rest of its duties.

Thanks
WW

---

How To Hide Macro Option From Tools Macro, Macros
Hi,
Well, this is the situation. I created some macros (6) for a workbook. One this macros is adding a new Menu in the main Excel Menu. The idea is that the user does not need to go to options: Tools, Macros, Macro...and run the macro because I want them to do it from the menu specially created.
Also I prevented any user to edit the macros putting password if they want to see the codes.
Now How I can prevent a user to run all my macros from the option:
Tools, Macros, Macro...Can I hide a Macro from that menu?

Any way to remove this option in just this workbook not affecting the user if they want to work with a new one...?
Or may be a message saying that macro can be run from the menu if the user is trying too.
Any suggestion?
Thanks!
Gonza

---

Do/Loop,Need To Nest Another Loop To Check For Duplicates(FIGURED IT OUT)
check it out, what i am doing is reading in from my DB, customer orderID's. The table that i am reading from will have multiple OrderID's and some will be duplicates. That all fine but i dont want to have order number 115 show up 3 times when 1 time would be enough. This is the loop that i am using and am loading the values in the the combo box. What i would like to do, is once i hit this line of code

Combo2.List(i) = ![OrderID]

then do either a for each , or for next loop to walk through the contents of combo2 and check for a duplicate, if a duplicate is found i would like to take the current orderID that was just loaded out of the combo2 box. I have tried a for each loop but i am not geting the syntax correct of what exactly i am trying to search through. That where you guys come into play. could some one please help with this problem

Do Until .EOF
   Combo2.List(i) = ![OrderID]
   i = i + 1
   .MoveNext
Loop

This is what i would like to accomplish.
DO Until .EOF
    load orderID into combo box
        For Each orderID in combo box
             If duplicate found then
                  delete current entry
             end if
         next
     continue loading orderid's
loop



Edited by - lmf232s on 7/24/2003 1:59:30 PM

---

Can You Get An Access Macro To Include Running An XL Macro
Is it possible to have an MS access run its own "thing" and in the middle of it all call on excel to run it owns macro?

---

Word 200 Vba Macro Help - Enable Track Changes In A Macro. Thanks
I was able to find a macro which takes an already mail merged document, and saves each each document as a separate file. The document's filename is taken from the already merged document. The script works. It's in red. See below.

The problem is I need to enable the track changes option.I recorded the following macro. It's in blue.
With ActiveDocument
.TrackRevisions = True
.PrintRevisions = True
.ShowRevisions = True
End With
End Sub

I tried to incorporate this code(blue) into the code (red) below. I added it between ActiveDocument.Sections.First.Range.Cut and Documents.Add but it didn't work.

ActiveDocument.Sections.First.Range.Cut
ActiveDocument.TrackRevisions = True
ActiveDocument.PrintRevisions = True
ActiveDocument.ShowRevisions = True
Documents.Add

It turned on track changes but it didn't create each new document. What am I doing wrong?


Desperately Seeking help!!

Script works perfectly.
Sub SplitMergeLetter()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
'
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
sName = Selection
'set path below
sPath = "C:MERGELETTERS"
Docname = sPath & sName
ActiveDocument.Sections.First.Range.Cut

Documents.Add
With Selection
.Paste
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
End Sub

---

Game Loop Without Creating An Endless Loop?
im trying to setup a loop for my game to draw the scene as many times as it can each second, however, i end up simply creating a loop that stops basically everything. timers do not function, command buttion clicks are ignored, not what i wanted.

so, then i tried a timer, but even at a setting of 1 it was too slow for my purpose. (unless you want to play the game limited to 10 FPS ) so, is there any faster timer system, or a differnt loop system i didnt think of?
thanks

---

Call Macro ~change Macro
I want to create a print preview from a access rapport

I'm using this code:

Code:
Private Sub Command1_Click()
Dim A As Object

Set A = CreateObject("Access.Application")
A.Visible = true
A.OpenCurrentDatabase (App.Path & "
ewP2.mdb")
A.docmd.RunMacro "macroprinten"
ENd SUb
the first macrocommand is openreport + report name
at this instruction there is a posibility to specify a WHERE instruction.

Is it posible to chance this where instruction in visual basic
?


Many thx
grz
EBS

---

Run Access Macro From Excel Macro
Hi

I am using Microsoft Office 2000 and trying to run an Access macro from an Excel macro, but my Excel macro does not seem to be working. When I run the Excel macro, nothing happens - I do not get an error and the code does not do what it is suppossed to. Below is my code:

Code:
Sub DisplayForm()
' Initialize string to database path.
Const strConPathToSamples = "C:Miscell est.mdb"

strDB = strConPathToSamples & "test.mdb"
' Create new instance of Microsoft Access.
Set appAccess = _
CreateObject("Access.Application")
' Open database in Microsoft Access window.
appAccess.OpenCurrentDatabase strConPathToSamples
' Run Access macro.
appAccess.DoCmd.RunMacro "Macro1", 1
End Sub
I have included the references to "Microsoft DAO 3.6 Object Library" and "Microsoft Access 9.0 Object Library."
Any help on this subject would be much appreciated.
Thanks

---

Modifying Macro Or Form With Macro
Is it possible to modify a userform or macro in a module with another macro?

I've got a database of clients that will probably have new clients from time to time. Currently using userforms to give check lists and of course that stuff is referenced in macros. Would be cool to write a macro that would allow a user to modify that stuff to add in choices as needed.

Can this be done?

---

Attatch A Macro To A Button With A Macro?
I am creating a new sheet using VBA, I would like to be able to add a button to this sheet (which I can do), and attach a macro to the button (which I cannot).

Can anyone tell me how to attatch a macro to a button using another macro? Or any other way of making the newly created button actually do anything?

Thanks!
-Shiv

---

Lotus Macro To Excel Macro Please Help!!
I know nothing about Lotus but I need to convert Lotus macro to Microsoft Excel. Can anyone help

---

Open Specific Drive, And Then Close The Specific Drive Again
Hi there,

I have found this code on vbcity forums (look below) and it works, it asks wich drives needs to be openend. well thats great Just what i needed. Now i can choose wich drive i will open. But the next thing, i want the drive to close again when i push a buton in my form. I have looked at the code, but i could not configure out what the function for this is. I only need it for windows nt/2000/xp but for win9X would be helpfull to...

Thanks in advance

Code:'Example by Howard Henry Schlunder
' This example requires one command button (Command1)
Private Declare Function GetVersion Lib "kernel32" () As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const INVALID_HANDLE_VALUE = -1
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_DELETE_ON_CLOSE = 67108864
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const IOCTL_STORAGE_EJECT_MEDIA = 2967560
Private Const VWIN32_DIOC_DOS_IOCTL = 1
  
Private Type DIOC_REGISTERS
  reg_EBX As Long
  reg_EDX As Long
  reg_ECX As Long
  reg_EAX As Long
  reg_EDI As Long
  reg_ESI As Long
  reg_Flags As Long
End Type
  
Private Sub Command1_Click()
Dim hDrive As Long, DummyReturnedBytes As Long
Dim EjectDrive As String, DriveLetterAndColon As String
Dim RawStuff As DIOC_REGISTERS
  EjectDrive = InputBox("Which drive shall we try to eject the media from?", "Eject Media")
  If Len(EjectDrive) Then 'Confirm the user didn't cancel
    DriveLetterAndColon = UCase(Left$(EjectDrive & ":", 2)) 'Make it all caps for easy interpretation
    If GetVersion >= 0 Then 'We are running Windows NT/2000
      hDrive = CreateFile("\." & DriveLetterAndColon, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0, OPEN_EXISTING, 0, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Eject media!
        Call DeviceIoControl(hDrive, IOCTL_STORAGE_EJECT_MEDIA, 0, 0, 0, 0, DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive) 'Clean up after ourselves
      End If
    Else 'We are running Win9x/Me
      hDrive = CreateFile("\.VWIN32", 0, 0, ByVal 0, 0, FILE_FLAG_DELETE_ON_CLOSE, 0)
      If hDrive <> INVALID_HANDLE_VALUE Then
        'Setup our raw registers to use Interrupt 21h Function 440Dh Minor Code 49h
        RawStuff.reg_EAX = &H440D 'The function to use
        RawStuff.reg_EBX = Asc(DriveLetterAndColon) - Asc("A") + 1 'The drive to do it on
        RawStuff.reg_ECX = &H49 Or &H800 'The minor code of the function in the low byte of the low word and the device category of 8 in the high byte of the low word
        'Eject media!
        Call DeviceIoControl(hDrive, VWIN32_DIOC_DOS_IOCTL, RawStuff, LenB(RawStuff), RawStuff, LenB(RawStuff), DummyReturnedBytes, ByVal 0)
        Call CloseHandle(hDrive) 'Clean up after ourselves
      End If
    End If
  End If
End Sub



Edited by - Devoney on 5/1/2005 8:23:30 AM

---