DBDivaAuto
IS-IT--Management
I am using VB to programmatically read a spreadsheet then call another spreadsheet to run a series of macros - the first macro is refreshing all of the data to match the item in the list view box. This macro takes about 2 full seconds to run. I am trying to slow down my code calls to stop the Macro from running on top of itself... I put DoEvents in the VBA of the Macro. My vb code looks like this (I threw asterisks in - I have had time up to 1200 no help):
Code:
If IO.File.Exists(filename) Then
Dim Proceed As Boolean = False
Dim xlApp As excel.Application = Nothing
Dim xlWorkBooks As excel.Workbooks = Nothing
Dim xlWorkBook As excel.Workbook = Nothing
Dim xlWorkSheet As excel.Worksheet = Nothing
Dim xlWorkSheets As excel.Sheets = Nothing
Dim xlCells As excel.Range = Nothing
Dim ColumnNumber As Integer = 1
xlApp = New excel.Application
xlApp.DisplayAlerts = False
xlWorkBooks = xlApp.Workbooks
xlWorkBook = xlWorkBooks.Open(filename)
xlApp.Visible = True
xlWorkSheets = xlWorkBook.Sheets
Dim i As Integer = 0
For Each item In Pick_Tickets.lvPalms.Items
xlWorkSheet = CType(xlWorkSheets(Name1), excel.Worksheet)
xlWorkSheet.Activate()
xlWorkSheet.Cells(5, 3) = Left(Pick_Tickets.lvPalms.Items(i).SubItems(1).Text, 2) & Pick_Tickets.lvPalms.Items(i).SubItems(1).Text.Substring(3, 2)
'MessageBox.Show(Pick_Tickets.lvPalms.Items(i).SubItems(0).Text)
xlWorkSheet.Cells(6, 3) = Pick_Tickets.lvPalms.Items(i).SubItems(0).Text
Dim pick1 As excel.Range = CType(xlWorkSheet.Cells(15, 7), excel.Range)
Dim pick2 As excel.Range = CType(xlWorkSheet.Cells(19, 7), excel.Range)
Do Until pick1.Value = pick2.Value '******************************************************************
xlApp.Run("Macro9")
If pick1.Value = pick2.Value Then
Exit Do
End If
Threading.Thread.Sleep(500)
Loop '**************************************************************************************************
Dim getMyMacro As String = GetMacro(Pick_Tickets.lvPalms.Items(i).SubItems(2).Text, Pick_Tickets.lvPalms.Items(i).SubItems(0).Text, Pick_Tickets.lvPalms.Items(i).SubItems(1).Text)
'MessageBox.Show(getMyMacro)
'If getMyMacro <> "" Then
'xlApp.Run(getMyMacro)
'xlWorkSheet = CType(xlWorkSheets(Pick_Tickets.lvPalms.Items(i).SubItems(2).Text), excel.Worksheet)
'xlWorkSheet.Activate()
'xlApp.Run("Button1_Click")
'End If
i = i + 1
Next
xlWorkBook.Close()
xlApp.UserControl = True
xlApp.Quit()
xlCells = Nothing
xlWorkSheets = Nothing
xlWorkSheet = Nothing
xlWorkBook = Nothing
xlWorkBooks = Nothing
xlApp = Nothing
Else
MessageBox.Show("'" & filename & "' not located. ")
End If
End Sub