I have created some code to populate combo boxes on my form from a excel file when the form loads.
As part of the code, it is supposed to release the objects associated but it does not
Dim excel As New Excel.Application
Dim w As Excel.Workbook = excel.Workbooks.Open("C:\Email Template\Violations Log\Violations Log.xlsx")
Dim sheet As Excel.Worksheet = w.Worksheets("Individual Data")
Dim r As Excel.Range = sheet.Range("A2:A300")
Dim array(,) As Object = r.Value(excel.XlRangeValueDataType.xlRangeValueDefault)
Dim sheet2 As Excel.Worksheet = w.Worksheets("Category")
Dim s As Excel.Range = sheet2.Range("A2:A20")
Dim array2(,) As Object = s.Value(excel.XlRangeValueDataType.xlRangeValueDefault)
Dim bound0 As Integer = array.GetUpperBound(0)
Dim bound1 As Integer = array.GetUpperBound(1)
Dim j As Integer
Dim x As Integer
Dim s1 As String
If array IsNot Nothing Then
' Loop over all elements.
For j = 1 To bound0
For x = 1 To bound1
s1 = array(j, x)
If s1 IsNot Nothing Then
If Not ComboBox1.Items.Contains(s1.ToString) Then
ComboBox1.Items.Add(s1.ToString)
End If
End If
Next
Next
End If
If array IsNot Nothing Then
' Loop over all elements.
For j = 1 To bound0
For x = 1 To bound1
s1 = array2(j, x)
If s1 IsNot Nothing Then
If Not ComboBox2.Items.Contains(s1.ToString) Then
ComboBox2.Items.Add(s1.ToString)
End If
End If
Next
Next
End If
w.Close(False)
excel.Quit()
ReleaseObject(excel.XlRangeValueDataType.xlRangeValueDefault)
ReleaseObject(excel)
ReleaseObject(array)
ReleaseObject(array2)
ReleaseObject(r)
ReleaseObject(s)
ReleaseObject(sheet)
ReleaseObject(sheet2)
ReleaseObject(w)
ReleaseObject(bound0)
ReleaseObject(bound1)
ReleaseObject(j)
ReleaseObject(x)
ReleaseObject(s1)
Ive tried to release every object that is referenced but it still has a connection to the excel document.
Have I missed an object? or something bigger?
I have another code that copies from the form to that same excel document and that does not leave any processes open. (I have to kill the excel process that is created from loading the form to be able to use the code to copy data)
Any help would be greatly appreciated.
Figured it out.
The code would stop running and not complete the release object section of the code.
Using debugging I found that I was getting an error message which was muted. I resolved the error message and now it runs fine.
Thanks for trying to help.
Related
I need, for some reason, the category names of my chart. Here's what I got so far:
xlWorkbook = xlApp.ActiveWorkbook
Dim wsnat As Excel.Chart = TryCast(xlWorkbook.ActiveChart, Excel.Chart)
If Not wsnat Is Nothing Then
Dim axxxis As Excel.Axis = DirectCast(wsnat.Axes(Excel.XlAxisType.xlCategory, Excel.XlAxisGroup.xlPrimary), Excel.Axis)
Dim areyoukiddingme As Object = axxxis.CategoryNames
Dim arr As Array = DirectCast(areyoukiddingme, Array)
For q As Integer = 0 To arr.GetUpperBound(0)
Debug.Print(arr(q).ToString) ' HERE, the array 'arr' has two things which are EMPTY!
Next
End If
My problem is, that the array (arry) has the correct amount of EMPTY objects. If I do the whole thing in VBA, it works as expected. But it does not for VB.net. Any clues?
Here's the code in VBA:
Sub test()
Dim chrt As Chart
Set chrt = ActiveChart
Dim names As Variant
names = chrt.Axes(xlCategory, xlPrimary).CategoryNames
End Sub
This sub nicely outputs the category names of my chart!
I would like to count the lines that have values. I tried oSheet.Rows.Count but that doesn't work. Any idea about this?
My code is the following:
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets("Sheet")
oSheet.Range("A" & max).Value = "0000111"
oSheet.Range("B1").Value ="Name"
oBook.SaveAs("C:\New folder\excel\" & datenw & ".xlsx")
oExcel.Quit()
As said in the comments, the following code should get you the count of rows that have values based on your Range:
Dim rowCount As Integer = oSheet.UsedRange.Rows.Count()
There is however a slight issue with your code I believe. This probably won't work:
oSheet = oBook.Worksheets("Sheet")
The reason it won't, is because "Sheet" doesn't exist on a new Workbook. "Sheet1" does, so this needs to be changed to:
oSheet = oBook.Worksheets("Sheet1")
'or
oSheet = oBook.Worksheets(1) 'remember Excel collections are one based not zero based
Lastly I would look at the way you are closing Excel as oExcel.Quit() is probably leaving an instance of Excel running. Have a look at this answer which links to Siddharth Rout's bit of code:
Private Sub ReleaseObject(ByVal obj As Object)
Try
Dim intRel As Integer = 0
Do
intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
Loop While intRel > 0
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
You also to make sure you release in the right order and release everything. This is usually in backwards order:
ReleaseObject(oSheet)
oBook.Close()
ReleaseObject(oBook)
oExcel.Quit()
ReleaseObject(oExcel)
However with all that said I would look at using the Microsoft.Office.Interop.Excel namespace directly rather than declaring objects:
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Dim oExcel As New Excel.Application
Dim oWorkbooks As Excel.Workbooks = oExcel.Workbooks
Dim oWorkbook As Excel.Workbook = oWorkbooks.Add()
Dim oSheets As Excel.Sheets = CType(oWorkbook.Sheets, Excel.Sheets)
Dim oWorksheet As Excel.Worksheet = CType(oSheets(1), Excel.Worksheet)
Dim oARange As Excel.Range = oWorksheet.Range("A" & max.ToString()) 'Not sure what max is but I took the assumption it's an Integer
oARange.Value = "0000111"
Dim oBRange As Excel.Range = oWorksheet.Range("B1")
oBRange.Value = "Name"
Dim oUsedRange As Excel.Range = oWorksheet.UsedRange()
Dim rowCount As Integer = oUsedRange.Rows.Count()
oWorkbook.SaveAs("C:\Test.xlsx")
ReleaseObject(oUsedRange)
ReleaseObject(oBRange)
ReleaseObject(oARange)
ReleaseObject(oWorksheet)
ReleaseObject(oSheets)
oWorkbook.Close()
ReleaseObject(oWorkbook)
ReleaseObject(oWorkbooks)
oExcel.Quit()
ReleaseObject(oExcel)
End Sub
Private Sub ReleaseObject(ByVal obj As Object)
Try
Dim intRel As Integer = 0
Do
intRel = System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
Loop While intRel > 0
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
I would also then look at turning Option Strict On:
Restricts implicit data type conversions to only widening conversions, disallows late binding, and disallows implicit typing that results in an Object type.
Define a row variable as Long, then start a loop which will end when it finds a blank value in column A:
Dim lRow as Long = 1
Do until oSheet.Range("A" & lRow).Value=""
' increment the loop variable
lRow+=1
Loop
' display the result in a message block
MsgBox(lRow-1)
I have a RecordSet loop inside another RecordSet loop. It'd work well if it didn't take 45 secs for the .OpenRecordSet to run, and the table it'll open has 445k registers.
The reason for the inside loop is because I need to filter results obtained from another RecordSet, and then get these new results and compare.
Would it be better to use other methods, or other way? Is there another way to get specific data from a table(a faster way, of course)? Should I try multithreading?
Since people might need my code:
Private Sub btnGetQ_Click()
Dim tabEQ As DAO.Recordset: Dim tabT7 As DAO.Recordset: Dim tabPesqC As DAO.Recordset: Dim PesqCqdf As DAO.QueryDef
Dim index As Integer: Dim qtdL As Long: Dim qtdL2 As Long
Dim arrC() As String: Dim arrC2() As String: Dim arrC3() As String
Set tabEQ = dbC.OpenRecordset("EQuery", dbOpenSnapshot)
Set tabT7 = dbC.OpenRecordset("T7Query", dbOpenSnapshot)
If Not tabEQ.EOF Then
tabEQ.MoveFirst
qtdL = tabEQ.RecordCount - 1
ReDim arrC(qtdL): ReDim arrC2(qtdL)
If Not tabT7.EOF Then
tabT7.MoveFirst: index = 0
Do Until tabT7.EOF
arrC(index) = tabT7.Fields("CCO"): arrC2(index) = tabT7.Fields("CCE")
Set PesqCqdf = dbC.QueryDefs("pesqCCO")
PesqCqdf.Parameters("CCO") = arrC(index)
Set tabPesqC = PesqCqdf.OpenRecordset(dbOpenSnapshot)
qtdL2 = tabPesqConj.RecordCount - 1
If qtdL2 > 0 Then
ReDim arrC3(qtdL2)
Dim i As Integer
For i = 0 To UBound(arrC3)
arrC3(i) = tabPesqC.Fields("CCE")
tabPesqC.MoveNext
Next
End If
On Error GoTo ERROR_TabT7
index = index + 1: tabT7.MoveNext
Loop
End If
ERROR_TabT7:
Set tabT7 = Nothing
End If
If IsObject(tabEQ) Then Set tabEQ = Nothing
End Sub
I created tables linked with what i wanted :/
I have an automation script running whose output is various document types and printing those documents with various printer settings. I am printing to the same printer for all documents, so that's nice. I have three excel worksheets that need to be printed. These I am printing using the built-in "PrintOutEx" method. One onto a letter size paper and two to 11x17. Next, I have the script print a word document, which I am printing using the built-in "PrintOut" method. This is to be printed on an 11x17 paper but scaled so that two pages print side by side. Lastly, I have to print a multi-page tiff document which I am printing using a print handler. I am having a number of issues with this and I apologize if these are silly question and appreciate any help I can gather.
I am trying to keep the default printer the same as when I start the subroutines and that doesn't seem to be working using the PrinterSettings methods.
About the default printer: the default printer changes to the printer I want (doesn't change back at the end). The default printer is set to 11x17. If I change the default settings of the printer to 8.5x11 everything prints to 8.5x11.
The script seems to be ignoring the settings/pagesettings/setups that I am providing it with.
The word document print is not scaled to fit the paper and I have tried setting the paper size to 11x17 as well as 8.5x11 and scaling the print but that just looks really bad.
The first excel worksheet does not print to a letter size paper.
The second and third worksheets work okay (as long as the default printer settings are as desired; see point 2).
The multipage tiff document prints okay as long as the default printer's default settings are correct.
I am not a professional programmer so I apologize if the question has a simple answer or the code looks horrifying. I researched tons on this question and couldn't find a solution that worked. :( I stepped through the code line by line and there are no errors. I am attaching the code I have thus far.
Thanks!!!
Public Sub PrintSPIDPackage(SPID As String)
On Error GoTo errHandler
Dim printerSettings As New Printing.PrinterSettings
Dim curPrinter As String
Dim engPrinter As String
Dim purPrinter As String
engPrinter = "engBLAH"
purPrinter = "purBLAH"
curPrinter = printerSettings.PrinterName
Dim spidBBPath As String
spidBBPath = ****REDACTED
spidDrawingPackagePath = ***REDACTED***
Dim eAPP As New Excel.Application
Dim wB As Excel.Workbook
Dim wS As Excel.Worksheet
Dim rng As Excel.Range
Dim lRow As Integer
Dim wAPP As New Word.Application
Dim doc As Word.Document
wB = eAPP.Workbooks.Open(spidBBPath)
wS = wB.Worksheets(selectedSheet & " OPs")
wS.PageSetup.PaperSize = Excel.XlPaperSize.xlPaperLetter 'I would think this causes the printer to printout to a letter size paper
wS.PrintOutEx(ActivePrinter:=engPrinter)
wS = wB.Worksheets(selectedSheet)
lRow = wS.Range("A" & wS.Rows.Count).End(Excel.XlDirection.xlUp).Row + 3
rng = wS.Range("A1:I" & lRow)
rng.PrintOutEx(ActivePrinter:=engPrinter) 'PRINT SHOULD BE AN 11x17
wS = wB.Worksheets(selectedSheet & " MLB")
wS.PrintOutEx(ActivePrinter:=engPrinter) 'PRINT SHOULD BE AN 11x17
wB.Close(False)
eAPP.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(wS)
Runtime.InteropServices.Marshal.ReleaseComObject(wB)
Runtime.InteropServices.Marshal.ReleaseComObject(eAPP)
If InStr(xPath, ".doc") <> 0 Then
doc = wAPP.Documents.Open(xPath)
wAPP.ActivePrinter = engPrinter
doc.PageSetup.PaperSize = Word.WdPaperSize.wdPaperLetter ''''''print out should be 11x17 with two pages side by side
wAPP.PrintOut(PrintZoomColumn:=2, PrintZoomRow:=1) ', PrintZoomPaperHeight:=2 * (11 * 1440), PrintZoomPaperWidth:=2 * (8.5 * 1440)) '''''AS you see I tried scaling...
doc.Close(False)
doc = Nothing
wAPP.Quit()
wAPP = Nothing
End If
Dim pDoc As New Printing.PrintDocument
currPage = 0
AddHandler pDoc.PrintPage, AddressOf pDocPage
PrintDialog1.Document = pDoc
pDoc.DefaultPageSettings.Landscape = True
pDoc.DocumentName = SPID & "-Drawing Package"
pDoc.PrinterSettings.PrinterName = engPrinter
pDoc.DefaultPageSettings.Landscape = True
pDoc.DefaultPageSettings.Margins.Left = 50
pDoc.DefaultPageSettings.Margins.Right = 50
pDoc.DefaultPageSettings.Margins.Top = 50
pDoc.DefaultPageSettings.Margins.Bottom = 50
Dim ps As New Printing.PaperSize("Tabloid", 1700, 1100)
ps.PaperName = Printing.PaperKind.Tabloid
pDoc.DefaultPageSettings.PaperSize = ps
pDoc.Print()
printerSettings.PrinterName = curPrinter 'this should reset the user's default printer to the original setting to before when this routine started??
Exit Sub
errHandler:
MsgBox(Err.Description)
End Sub
Sub pDocPage(ByVal sender As Object, ByVal e As Printing.PrintPageEventArgs)
Dim img As Image = Image.FromFile(spidDrawingPackagePath)
Dim pCount = img.GetFrameCount(FrameDimension.Page)
img.SelectActiveFrame(FrameDimension.Page, currPage)
Using stReader As IO.MemoryStream = New IO.MemoryStream
img.Save(stReader, ImageFormat.Bmp)
Dim bmp As Bitmap = CType(Image.FromStream(stReader), Bitmap)
e.Graphics.DrawImage(bmp, 0, 0)
bmp.Dispose()
End Using
currPage += 1
If currPage < pCount Then
e.HasMorePages = True
End If
End Sub
I'm trying to edit embedded charts in Word documents. My source code is below. It has worked a long time but not for the last two days. I get this error:
Run-time error '7': Out of memory
I have searched a lot , but I don't understand the problem. When I shutdown computer and after open it, then it works correctly, but after I get error again.
It gives error in this part:
'create range with Cell
Set oChart = oInShapes.Chart
oChart.ChartData.Activate ' ***Note: It gives error here***
'Set oWorkbook = oChart.ChartData.Workbook
Set oWorksheet = oChart.ChartData.Workbook.Worksheets("Tabelle1")
Set oRange = oWorksheet.Range(Cell)
Public Sub updatechart(Doc As word.Application, ChartName As String, ChartTitle As String, Cell As String, data As String)`
Dim oInShapes As word.InlineShape
Dim oChart As word.Chart
Dim oWorksheet As Excel.Worksheet
'Dim oWorkbook As Excel.Workbook
Dim columnArray() As String
Dim rowArray() As String
Dim oRange As Range
Dim i As Integer
Dim j As Integer
For Each oInShapes In Doc.ActiveDocument.InlineShapes
' Check Shape type and Chart Title
If oInShapes.HasChart Then
'create range with Cell
Set oChart = oInShapes.Chart
oChart.ChartData.Activate ' ***Note: It gives error here***
'Set oWorkbook = oChart.ChartData.Workbook
Set oWorksheet = oChart.ChartData.Workbook.Worksheets("Tabelle1")
Set oRange = oWorksheet.Range(Cell)
' Commet for debug
'oWorksheet.Range("B33") = (ChartTitle & 33)
' Split text
columnArray = Split(data, SeperateChar)
For i = LBound(columnArray) To UBound(columnArray)
rowArray = Split(Trim(columnArray(i)), " ")
' Set Title. For example; ChartTitle = "XY" ----- Table Titles ----> | XY1 | XY2 | XY2 | ....
' After Set Value | 0,33| 0,1 | 0,46| ....
oRange.Cells(1, i + 1) = ChartTitle & (i + 1)
For j = LBound(rowArray) To UBound(rowArray)
' Set Values
oRange.Cells(j + 2, i + 1) = CDbl(rowArray(j))
Next j
Next i
'oWorkbook.Close
oChart.Refresh
End If
Next
Set oInShapes = Nothing
Set oChart = Nothing
Set oWorksheet = Nothing
'Set oWorkbook = Nothing
Erase rowArray, columnArray
End Sub
This has happened to me before. I had the same solution, exit excel, free up some memory and try again - and it worked. You may have to shut down other programs while using this. Its literally what it says it is, lack of available memory.
Keep in mind that if you've run other macros that copy information to the clipboard, you will have less RAM freed up to run the macro.
Also, are you using 32 or 64 bit Excel - 64 will allow you to use more RAM.
I notice that you not set oRange to nothing when cleaning up your sub, could it be that this object is using a lot of memory which isn't being released when the sub ends?
I had a similar error and finally traced it down to the "For Each" statement. I think it has to do with the memory allocation for the Collection, Doc.ActiveDocument.InlineShapes in your example.
My bad code (PowerPoint to Excel):
For Each sh In InputBook.Sheets("Exec Sum").Shapes
sh.Visible = False
Next
Set sh = Nothing
My fixed code:
For i = 1 To InputBook.Sheets("Exec Sum").Shapes.Count
InputBook.Sheets("Exec Sum").Shapes(i).Visible = False
Next
Avoiding a reference to a collection solved my issue.
The frequent access to the worksheet can create problems with resource usage. The way to go about this is to fetch data in a single access point, like
Dim V as Variant
V = InputRange
' Now V becomes a m x n array of the cell values in InputRange
' you may manipulate and work with this data and fill all your results in
' OutputV(m,n) variant array
Dim OutputV() as Variant
ReDim OutputV(m,n)
oRange = OutputV
Usually speeds up the code by several hundred times depending on the size of the range and also uses far less resources.