VBA code Running too fast, How do I slow it down?

I basically have Autocad extracting attributes to a text file on our server,
the have some VBA code opening Excel, formatting the data, and copy/pasting
it into another Excel doc. The problem is, that the time it takes Autocad
to the server (about a sec or two) the code it al ready trying to access the
new text file before it is finished writing. Any ideas of how I could delay
the app from moving on?

Thanks again for any assistance. You all are very wonderful people for your
support. I have learned a lot from this group, and I have been writing VB
now for only a few days.

 

Something like this, with a 5 or 10 second pause?

I'm not familiar with attribute extraction, but I'm surprised it doesn't
finish writing the file. Are you using SendCommand in your subroutine?

-- James


Public Sub PausePreview()

Dim i As Long, pauseTime As Double, start As Double
pauseTime = 5 'seconds

ThisDrawing.SendCommand ("preview" & vbCr)

If Timer + pauseTime < (24 * 60 * 60) Then
start = Timer
Do
Loop Until Timer > start + pauseTime
Else
'loop would have run for 24 hours before exiting...
'could enhance to loop until either:
' A) (time > endTime), or
' B) (date >= endDate) and (time > endTime)
End If

SendKeys "{ENTER}"

End Sub

 

Sounds like you need to restructure the app.

At some point, you're surrendering flow control to an external process.

Excel can be automated from within AutoCAD.

That's the approach I'd take.

 

I am using the send command to call up a lisp, I need to figure out how to
just convert the lisp to VBA.
I am very new at this, so I appreciate any help. Thanks!

[VBA code]
Private Sub CommandButton7_Click()
ThisDrawing.SendCommand "wallxport" & vbCr
Dim thisdwgpath As String
thisdwgpath = ThisDrawing.GetVariable("dwgprefix")
Dim excelApp As Excel.Application
Dim wbkObj As Workbook
Dim shtObj As Worksheet
On Error Resume Next
UserForm1.Hide
Err.Clear
Set excelApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set excelApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could not start Excel.", vbExclamation
End
End If
End If
'Clear Clipboard
Dim oDataObject As DataObject
Set oDataObject = New DataObject
oDataObject.SetText ""
oDataObject.PutInClipboard
Set oDataObject = Nothing
'End Clear Clipboard
AppActivate ThisDrawing.Application.Caption
excelApp.Visible = True
'verify file location
If Dir$(thisdwgpath & "\data\wallxport.txt") = " " Then
MsgBox "The file was not found. Please try again!"
End If
'verify file location end
Workbooks.OpenText FileName:= _
(thisdwgpath & "\data\wallxport.txt"), Origin:=437 _
, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlSingleQuote,
_
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False,
Comma:=True, _
Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2,
1), Array( _
3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8,
1), Array(9, 1), Array(10 _
, 1)), TrailingMinusNumbers:=True
Cells.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1:J250").Select
Selection.Cut
Workbooks.Open FileName:= _
(thisdwgpath & "data\Quantities.xls"), Origin _
:=xlWindows
Sheets("Walls").Select
Range("B3").Select
ActiveSheet.Paste
Range("A1").Select
Range("A4:A5").Select
Range("A5").Activate
Selection.AutoFill Destination:=Range("A3:A5"), Type:=xlFillDefault
Range("A3:A5").Select
Range("A1").Select
ActiveWorkbook.Close SaveChanges:=True
ActiveWorkbook.Close SaveChanges:=False
excelApp.Quit
End Sub


[Wallxport.lsp]
(defun c:WALLXPORT ()
(command "filedia" "0")
(setq EXPORTFILE (strcat (getvar "dwgprefix")"data\\WALLXPORT"))
(command "-attext" "cdf" "walltemplate" EXPORTFILE /013)
(command "filedia" "1")
(princ)
)

 

Yup! Guess so, I got this far, but its just a beginning, thanks.

 

Here's another (nearly identical) time-wasting routine. Of course, the cool
thing to do would be to write the attributes directly to your target Excel
worksheet.

' wait a given number of seconds
Public Sub Wait(sngWaitTime As Single)
Dim sngEndTime As Single
Debug.Print "Start Time: " & CStr(Timer())
sngEndTime = Timer() + sngWaitTime
' if interval doesn't span system date rollover
If Not Timer() > sngEndTime Then
Do While Timer() < sngEndTime
' just waste time
Loop
End If
Debug.Print "End Time: " & CStr(Timer())
End Sub

 

Try adding:

do events

--
David Wishengrad
President & CTO
MillLister, Inc.
Software for BOM, measuring, stretching and controlling visibility of
multiple 3D solids.
Http://Construction3D.com