For whatever reason I keep getting an "Out of Memory Error" whenever I attempt to execute it. if I remove the GetItemsNames for the inventory it dosent throw the error but even if I debug.print anything it will throw the error. The laptop I'm using isn't new by any means but it has 6GB of Ram and is a 64bit OS. Not only that but the memory dosent even spike when I run the code. Its using 20mb at max. Is it a problem with my VBA Structure? I'm fairly new to VBA but it doesn't seem like I should be running out of memory with such little actually happening. Not only that but the files the code is opening are only 4 or 5 rows. This must be an issue with excel itself or the execution of the code. I have two macro buttons. One to execute the SelectFolder function and one for the GrabMobeItems.
Public selectedFolder As String
Public Function IsExcelSheet(fileName As String) As Boolean
Dim tmpStr As String
tmpStr = Right(fileName, 4)
If tmpStr = "xlsx" Or tmpStr = "xlsm" Then
IsExcelSheet = True
Else
IsExcelSheet = False
End If
End Function
'Gets the names of each Item, and add its to a list
Sub GetItemNames(file As String, ByRef nmLst As Object)
'OpenData
On Error GoTo ErrHandler
Application.ScreenUpdating = False
If file <> ThisWorkbook.Path Then
Dim src As Workbook
Set src = Workbooks.Open(Path, True, True)
Else
src = ThisWorkbook
End If
'ReadData
Dim sh As Worksheet
Dim rw As Range
Dim RowCount As Integer
RowCount = 0
Set sh = activeSheet
For Each rw In sh.Rows
If sh.Cells(rw.Row, 1).Value = "" And sh.Cells(rw.Row + 1, 1).Value = "" Then
Exit For
End If
RowCount = RowCount + 1
nmLst.Add sh.Cells(rw.Row, 1).Value
Next rw
src.Close False
Set src = Nothing
Set sh = Nothing
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub SelectFolder()
Dim diaFolder As FileDialog
Dim selected As Boolean
' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
selected = diaFolder.Show
If selected Then
selectedFolder = diaFolder.SelectedItems(1)
End If
Set diaFolder = Nothing
End Sub
Sub GrabMobeItems()
Dim invNames As Object
Dim folderName As String
Dim FSOLibrary As FileSystemObject
Dim FSOFolder As Object
Dim FSOFile As Object
'Set the file name to a variable
folderName = selectedFolder
'Set all the references to the FSO Library
Set FSOLibrary = New FileSystemObject
Set FSOFolder = FSOLibrary.GetFolder(folderName)
Set FSOFile = FSOFolder.Files
'Use For Each loop to loop through each file in the folder
Dim isExSht As Boolean
Dim nmeLst As Object
Set nmeLst = CreateObject("System.Collections.ArrayList")
Set invNames = CreateObject("System.Collections.ArrayList")
For Each FSOFile In FSOFile
isExSht = IsExcelSheet(FSOFile.Name)
If isExSht = True Then
Call GetItemNames(FSOFile.Path, nmeLst)
Debug.Print nmeLst(3)
Else
End If
Next
'Release the memory
Set FSOLibrary = Nothing
Set FSOFolder = Nothing
Set FSOFile = Nothing
End Sub
Bookmarks