i am very new to VB.net and i'm trying to proceed step by step with my application.
The application i'm trying to build will collect a series of macros i've written in Excel VBA environment.
Now, the following code pasted below, is the initial part, where basically i try to load a workbook (to be used as Active workbook) and to "unload it".
The issue comes when, after "unloading" the workbook, i try to open the very same workbook in excel.
Excel application return an error that is "Open in read-only". This cannot be accepted, and i need to understand how to unload the workbook and release it from the myAPP.
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Dim workbook As Excel.Workbook
Dim worksheet As Excel.Worksheet
Dim APP As New Excel.Application
Private Sub opn_btn_Click(sender As Object, e As EventArgs) Handles opn_btn.Click
Dim strname As String
Dim cellname As String
With OpenFileDialog1
.InitialDirectory = "E:\Vs_Excel"
.Title = "Open xlsx file"
.ShowDialog()
End With
workbook = APP.Workbooks.Open(OpenFileDialog1.FileName)
worksheet = workbook.Worksheets("sheet1")
cellname = worksheet.Range("A1").Value
strname = OpenFileDialog1.FileName
Me.TextBox1.Text = strname
Me.TextBox2.Text = cellname
Dim lvwReport As View = View.List
With Me.ListView1
.GridLines = True
.View = lvwReport
.CheckBoxes = True
End With
'LoadListView() 'thi sroutine is written but not used yet. Must solve first the problem wioth closing ExcelApplication
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
workbook.Close()
APP.Quit()
Me.TextBox1.Text = ""
Me.TextBox2.Text = ""
ReleaseObject(worksheet)
worksheet = Nothing
ReleaseObject(workbook)
workbook = Nothing
ReleaseObject(APP)
APP = Nothing
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
MsgBox("Final Released obj # " & intRel)
Catch ex As Exception
MsgBox("Error releasing object" & ex.ToString)
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End class
Related
I have an excel sheet having 2 columns. Now i want that all values of column 1 should be stored in one list lets say ListTime and all values of column 2 should be stored in another list lets say ListAcceleration. I dont know how to do this.
Thanks in advance.
this is a good way:
Imports Microsoft.Office.Interop
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class FormMain
Private xlApp As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application
Private xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Private ListTime As New List(Of Double)
Private ListAcceleration As New List(Of Double)
Private Sub FormMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
Private Sub ButtonStart_Click(sender As Object, e As EventArgs) Handles ButtonStart.Click
Dim Path As String
Using OFD1 As New CommonOpenFileDialog
OFD1.Title = "Exceldatei auswählen"
OFD1.Filters.Add(New CommonFileDialogFilter("Excel", ".xlsx"))
OFD1.IsFolderPicker = False
OFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
If OFD1.ShowDialog = CommonFileDialogResult.Ok Then
Path = OFD1.FileName
Else
Return
End If
End Using
xlWorkBook = xlApp.Workbooks.Open(Path)
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet = CType(xlWorkBook.Worksheets("Tabelle1"), Microsoft.Office.Interop.Excel.Worksheet)
Dim xlRange As Microsoft.Office.Interop.Excel.Range = xlWorkSheet.UsedRange
Dim ER As Microsoft.Office.Interop.Excel.Range
For rCnt As Integer = 1 To xlRange.Rows.Count Step 1
ER = CType(xlRange.Cells(rCnt, 1), Microsoft.Office.Interop.Excel.Range)
ListTime.Add(CDbl(ER.Value))
ER = CType(xlRange.Cells(rCnt, 2), Microsoft.Office.Interop.Excel.Range)
ListAcceleration.Add(CDbl(ER.Value))
Next
xlWorkBook.Save()
xlWorkBook.Close()
xlApp.Quit()
If xlWorkSheet IsNot Nothing Then System.Runtime.InteropServices.Marshal.ReleaseComObject(xlWorkSheet)
If xlWorkBook IsNot Nothing Then System.Runtime.InteropServices.Marshal.ReleaseComObject(xlWorkBook)
If xlApp IsNot Nothing Then System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
xlWorkBook = Nothing
xlWorkSheet = Nothing
End Sub
Private Sub FormMain_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
If xlWorkBook IsNot Nothing Then xlWorkBook.Close()
If xlApp IsNot Nothing Then xlApp.Quit()
End Sub
End Class
There are just a few things you need to consider: First you have to download the “Microsoft.Office.Interop.Excel” package from Visual Studio's own NuGet package manager. Also the package “Microsoft.WindowsAPICodePack.Dialogs” to have a reasonable OpenFileDialog.
In the case of MS Office files, it is important to release the file using System.Runtime.InteropServices.Marshal.ReleaseComObject(..), otherwise you cannot edit it later when you click it on your desktop. In that case you would have to restart the PC. So don't forget. 😉
Oh and by the way: This word – in my case “Tabelle1” – will be named differently in your language. You have to change this.
I am exporting multiple DataTables to an Excel-file using ExcelLiabrary. The problem is that date column in all datatables, are being exported as number. DataTables are filled with data retrieved from Sql Server where the column type is date. Datagrids are also showing it correctly but in the excel it become numbers.
Here is the code to populate DataTable
Dim command = New SqlCommand("getdeta", sqlConn)
command.CommandType =
CommandType.StoredProcedure
Dim adapter = New SqlDataAdapter(command)
dt1 = New DataTable()
adapter.Fill(dt1)
dgv1.DataSource = dt1
and here is to Export data to Excel
Dim fileName = ExportAllDialog.FileName
datasetForExport.Tables.Add(dt1)
datasetForExport.Tables.Add(dt2)
ExcelLibrary.DataSetHelper.CreateWorkbook(fileName, datasetForExport)
So here is some code for the Microsoft.Office.Interop.Excel approach:
Option Strict On
Option Explicit On
Imports System.IO
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
Public Class ExcelBook
Private EXL As Excel.Application
Private Book As Excel.Workbook
Private Sheet As Excel.Worksheet
Private MyFileName As String
Protected Overrides Sub Finalize()
' Save and close the currently loaded Excel file
Close(True)
' Delete the local reference to the app BEFORE destroy
EXL = Nothing
MyBase.Finalize()
End Sub
Private Sub OpenApplication()
If EXL IsNot Nothing Then Return
EXL = New Excel.Application
EXL.Visible = False
EXL.DisplayAlerts = False
End Sub
Public Sub Open(Filename As String)
Open(Filename, 1)
End Sub
Public Sub Open(Filename As String, SheetIndex As Object)
OpenApplication()
' If another Excel file is open, close it
Close(True)
If File.Exists(Filename) Then
Book = EXL.Workbooks.Open(Filename)
Else
Book = EXL.Workbooks.Add()
End If
' Turns off warning messages when saving older files
Book.CheckCompatibility = False
UseSheet(SheetIndex)
MyFileName = Filename
End Sub
Public Sub Close(Save As Boolean)
If Book Is Nothing Then Return
If File.Exists(MyFileName) Then
Book.Close(Save)
Else
If Save Then Book.SaveAs(MyFileName)
Book.Close()
End If
Sheet = Nothing
Book = Nothing
MyFileName = Nothing
End Sub
Public Function UseSheet(Index As Object) As Boolean
If Book Is Nothing Then Return False
Try
Sheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
Sheet.Activate()
Return True
Catch Ex As COMException
Return False
End Try
End Function
Public Sub AddSheet(NewName As String)
AddSheet(NewName, Nothing)
End Sub
Public Sub AddSheet(NewName As String, Before As Object)
If Book Is Nothing Then Return
If SheetExists(NewName) Then Return
If Before Is Nothing OrElse Not SheetExists(Before) Then
Sheet = CType(Book.Sheets.Add(After:=Book.Sheets(Book.Sheets.Count)), Excel.Worksheet)
Else
Sheet = CType(Book.Sheets.Add(Before:=Book.Sheets(Before)), Excel.Worksheet)
End If
Sheet.Activate()
Sheet.Name = NewName
End Sub
Function SheetExists(Index As Object) As Boolean
If Book Is Nothing Then Return False
Dim LocalSheet As Excel.Worksheet
Try
LocalSheet = DirectCast(Book.Sheets(Index), Excel.Worksheet)
Catch Ex As COMException
LocalSheet = Nothing
End Try
Return LocalSheet IsNot Nothing
End Function
Public Sub RenameSheet(NewName As String)
If Sheet Is Nothing Then Return
If Not String.IsNullOrEmpty(NewName) Then Sheet.Name = NewName
End Sub
Public Sub FormatColumns(Columns As String, NewFormat As String)
If Sheet Is Nothing Then Return
Dim Rng = DirectCast(Sheet.Columns(Columns), Excel.Range)
Rng.NumberFormat = NewFormat
End Sub
Public Sub ImportTable(Table As DataTable)
If Sheet Is Nothing Then Return
If Table Is Nothing Then Return
If Table.Columns.Count = 0 Then Return
Dim Matrix(Table.Rows.Count, Table.Columns.Count) As Object
Dim Col As Integer
' Copy the datatable to an array
For Row As Integer = 0 To Table.Rows.Count - 1
For Col = 0 To Table.Columns.Count - 1
Matrix(Row, Col) = Table.Rows(Row).Item(Col)
Next
Next
' Add the column headers starting in A1
Col = 0
For Each Column As DataColumn In Table.Columns
Sheet.Cells(1, Col + 1) = Column.ColumnName
Col += 1
Next
' Add the data starting in cell A2
If Table.Rows.Count > 0 Then
Sheet.Range(Sheet.Cells(2, 1), Sheet.Cells(Table.Rows.Count + 1, Table.Columns.Count)).Value = Matrix
End If
End Sub
End Class
Then you could use this function to export your DataSet:
Private Sub ExportDataSet(DS As DataSet, Filename As String)
Dim DT As DataTable
Dim First As Boolean = True
With New ExcelBook
.Open(Filename)
For Each DT In DS.Tables
If First Then
.RenameSheet(DT.TableName)
First = False
Else
.AddSheet(DT.TableName)
End If
.ImportTable(DT)
Next
.UseSheet(1)
.Close(True)
End With
End Sub
Update: Releasing objects has no effect on Excel crashing. The problematic line is:
Dim wChartData = wChart.ChartData
I have written a VB.Net application that opens a word document, iterates through the inline shapes, and updates each chart with data from the database. Sometimes Excel will crash when opening the sheet containing the chart data. Can anyone tell me how I fix this?
Here is the code that iterates through the shapes:
wApp = New Word.Application
wApp.Visible = True
wDoc = wApp.Documents.Add("Some_File_Name.docx")
Console.WriteLine("Updating Charts")
Dim chartName As String
For Each wShape As Word.InlineShape In wDoc.InlineShapes
If wShape.HasChart = Core.MsoTriState.msoTrue Then
If wShape.Chart.HasTitle Then
chartName = wShape.Chart.ChartTitle.Text
Else
chartName = "NO_TITLE"
End If
UpdateChart(wShape.Chart, reportID, reportTitle,
reportUser, curriculumYear, chartName)
End If
Next
The UpdateChart subroutine grabs a SQL query and some options related to the chart, then fires off the FillChartData subroutine below:
Public Sub FillChartData(ByRef wChart As Word.Chart, ByVal sql As String,
Optional ByVal addDataPointsToLabels As Boolean = False)
If sql = "" Then Exit Sub
Dim cmd = O.factory.CreateCommand()
cmd.CommandText = sql
cmd.Connection = O.con
O.factory.CreateDataAdapter()
Dim adapter = O.factory.CreateDataAdapter
adapter.SelectCommand = cmd
Dim dt As New System.Data.DataTable()
Dim ds As New System.Data.DataSet()
adapter.Fill(ds, "report_name")
dt = ds.Tables(0)
Dim wChartData = wChart.ChartData
Dim wChartWb As Excel.Workbook = wChartData.Workbook
Dim wChartSheet As Excel.Worksheet = wChartWb.Sheets(1)
Dim title As String = "No title"
If wChart.HasTitle Then title = wChart.ChartTitle.Text.ToString
Dim r As Excel.Range
r = wChartSheet.Range("A1")
r.CurrentRegion.Clear()
For i = 0 To dt.Columns.Count - 1
Dim c As System.Data.DataColumn = dt.Columns(i)
r.Offset(0, i).Value2 = c.ColumnName
Next
r = wChartSheet.Range("A2")
For Each row As System.Data.DataRow In dt.Rows
For i = 0 To row.ItemArray.Count - 1
r.Offset(0, i).Value2 = row.Item(i)
Next
r = r.Offset(1)
Next
r = wChartSheet.Range("A1")
If addDataPointsToLabels Then
While r.Value <> ""
r.Value &= " " & r.Offset(1).Value
r = r.Offset(0, 1)
End While
End If
wChartWb.Close()
releaseObject(r)
releaseObject(wChartSheet)
releaseObject(wChartWb)
releaseObject(wChartData)
r = Nothing
wChartSheet = Nothing
wChartWb = Nothing
wChartData = Nothing
GC.Collect()
End Sub
The releaseObject subroutine is as follows:
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
MessageBox.Show(ex.ToString)
obj = Nothing
End Try
End Sub
And here's the crash report:
Problem signature:
Problem Event Name: APPCRASH
Application Name: EXCEL.EXE
Application Version: 15.0.5007.1000
Application Timestamp: 5a5eb36d
Fault Module Name: EXCEL.EXE
Fault Module Version: 15.0.5007.1000
Fault Module Timestamp: 5a5eb36d
Exception Code: c0000005
Exception Offset: 002b71c8
OS Version: 6.1.7601.2.1.0.256.4
Locale ID: 1033
Additional information about the problem:
LCID: 1033
skulcid: 1033
Read our privacy statement online:
http://go.microsoft.com/fwlink/?linkid=104288&clcid=0x0409
If the online privacy statement is not available, please read our privacy statement offline:
C:\Windows\system32\en-US\erofflps.txt
Thanks for your help!
You need to Activate the Word ChartData object to begin the inter-process communication between Word and Excel.
The example below is a simplified demonstration of code pattern and contains no error handling. This example also demonstrates releasing out of scope COM objects via the garbage collector. See this answer for more discussion on this COM clean-up procedure.
This code was verified against Office 2007.
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
Imports Word = Microsoft.Office.Interop.Word
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
InterOpWork("Embedded Excel Chart.docx")
COMCleanup()
End Sub
Sub InterOpWork(filePath As String)
Dim appWord As New Word.Application
Dim doc As Word.Document = appWord.Documents.Open((filePath))
Dim shp As Word.InlineShape = doc.InlineShapes(1)
Dim ch As Word.Chart = shp.Chart
Dim chData As Word.ChartData = ch.ChartData
chData.Activate() ' **** This is what your code is missing
Dim wb As Excel.Workbook = DirectCast(chData.Workbook, Excel.Workbook)
Dim appExcel As Excel.Application = DirectCast(wb.Application, Excel.Application)
Dim ws As Excel.Worksheet = DirectCast(wb.Worksheets("Sheet1"), Excel.Worksheet)
Dim rng As Excel.Range = ws.Range("B2:B4")
Dim dataToChange As Object(,) = DirectCast(rng.Value2, Object(,))
For i As Int32 = dataToChange.GetLowerBound(0) To dataToChange.GetUpperBound(0)
dataToChange(i, 1) = i * 2 + (5 - i)
Next
rng.Value = dataToChange
wb.Save()
wb.Close(False)
appExcel.Quit()
doc.Save()
doc.Close(False)
appWord.Quit()
End Sub
Private Sub COMCleanup()
Do
GC.Collect()
GC.WaitForPendingFinalizers()
Loop While Marshal.AreComObjectsAvailableForCleanup
End Sub
End Class
I'm trying to extract data from other 4 workbooks (some of them may have thousands of rows)
The Excel stops working, and restarts, after the extraction is completed.
I have the data extracted in the sheets so I assume that the excel is chrashing after the last workbook data is extracted.
I also tested with only one workbook and it crashes after closing.
I have read that we could use "DoEvents" and "Application.Wait" after copy/paste or close workbook, to let Excel finish some background work. I've tried that but with no success.
Any ideas why the Excel stops running / restarts?
Here is my code:
Public sysExtractParamsDictionary As Scripting.dictionary
'Sub rotine triggered when pressing button
Sub Extract()
Set sysExtractParamsDictionary = mUtils.FillDictionary("sysParams", "tExtractParams") 'Sub rotine belonging to mUtils module to fill dictionary with values from my sysParams sheet. Contains the sheets name.
mClean.Clean 'Sub rotine belonging to mClean module to clear sheets
ExtractData [sysInputDirectory], "Input Sheet" 'Cell Name sysInputDirectory
ExtractData [sysR2Directory], "R1 Sheet"
ExtractData [sysR2Directory], "R2 Sheet"
ExtractData [sysR3Directory], "R3 Sheet"
End Sub
Sub ExtractData(sFilePath As String, sDictionaryKey As String)
Dim oWorkbook As cWorkBook 'Class Module
Set oWorkbook = New cWorkBook
mUtils.SetStatusBarMessage True, "Extracting " & sDictionaryKey & " ..." 'Sub rotine belonging to my mUtils module to set on or off status bar message
oWorkbook.WorkBookDirectory = sFilePath
oWorkbook.OpenWorkBook oWorkbook.WorkBookDirectory
oWorkbook.CopiesSourceSheetValuesToDestinationSheet sysExtractParamsDictionary(sDictionaryKey)
oWorkbook.CloseWorkBook (False)
DoEvents
DoEvents
Application.Wait (Now + TimeValue("0:00:05"))
DoEvents
Set oWorkbook = Nothing
End Sub
'#### Class Module
Private wbWorkBook As Workbook
Private sWorkBookDirectory As String
Private sWorkBookName As String
Private wsWorksheet As Worksheet
Public Property Set Workbook(wbNew As Workbook)
Set wbWorkBook = wbNew
End Property
Public Property Get Workbook() As Workbook
Set Workbook = wbWorkBook
End Property
Public Property Let WorkBookDirectory(sFilePath As String)
sWorkBookDirectory = sFilePath
End Property
Public Property Get WorkBookDirectory() As String
WorkBookDirectory = sWorkBookDirectory
End Property
Public Property Let WorkBookName(sFileName As String)
sWorkBookName = sFileName
End Property
Public Property Get WorkBookName() As String
WorkBookName = sWorkBookName
End Property
Public Property Set Worksheet(wsNew As Worksheet)
Set wsWorksheet = wsNew
End Property
Public Property Get Worksheet() As Worksheet
Worksheet = wsWorksheet
End Property
Public Property Let WorkBookDirectory(sFilePath As String)
sWorkBookDirectory = sFilePath
End Property
Public Property Get WorkBookDirectory() As String
WorkBookDirectory = sWorkBookDirectory
End Property
'Class Module Function to Open WorkBook
Public Sub OpenWorkBook(sFilePath As String)
Dim oFSO As New FileSystemObject
Dim sFileName As String
Dim sLog As String
sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path
If sFileName = "" Then
sLog = "Error. Not possible to retrieve File Name from Directory."
Else
Me.WorkBookName = sFileName
Set Me.Workbook = Workbooks.Open(sFilePath)
If wbWorkBook Is Nothing Then
sLog = "Error opening file: " & Me.WorkBookName
Else
sLog = "File successfully openned!"
End If
End If
Set oFSO = Nothing
End Sub
'Class Module Function to Copy Values from source to destination
Public Sub CopiesSourceSheetValuesToDestinationSheet(wsDestinationName As Variant)
Dim wsDestination As Worksheet
Dim rStartRange As range
Dim rFullRangeToPaste As range
Set wsDestination = ThisWorkbook.Sheets(CStr(wsDestinationName)) ' Destination Sheet
Set Me.Worksheet = Me.Workbook.Sheets(1) 'Source Sheet
Set rStartRange = wsWorksheet.range("A1")
Set rFullRangeToPaste = wsWorksheet.range(rStartRange, mUtils.FindLast(3)) 'FindLast is a function belonging to mUtils module to find the last cell in worksheet
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
End Sub
'Class Module Function to Close Workbook
Public Sub CloseWorkBook(bSaveChanges As Boolean)
wbWorkBook.Saved = True
wbWorkBook.Close SaveChanges:=False
End Sub
'#### End Class Module
I've also tried to do it without Class Module (just in case something was wrong with objects), but i still have the same issue.
Sub Extract()
ExtractCopyClose "C:\MyFiles\InputData.csv", "Input"
End Sub
Sub ExtractCopyClose(sFilePath As String, wsDestinationName As String)
Dim wb As New Workbook
Dim wsDestination As Worksheet
Dim wsSource As Worksheet
Dim oFSO As New FileSystemObject
Dim sLog As String
Dim rStartRange As range
Dim rFullRangeToPaste As range
sFileName = oFSO.GetFileName(sFilePath) 'Get the File Name from Path
If sFileName = "" Then
sLog = "Error. Not possible to retrieve File Name from Directory."
Else
Set wb = Workbooks.Open(sFilePath)
If wb Is Nothing Then
sLog = "Error opening file: " & sWorkBookName
Else
sLog = "File successfully openned!"
End If
End If
Set oFSO = Nothing
Set wsDestination = ThisWorkbook.Sheets(wsDestinationName) ' Destination Sheet
Set wsSource = wb.Sheets(1) 'Source Sheet
Set rStartRange = wsSource.range("A1")
Set rFullRangeToPaste = wsSource.range(rStartRange, mUtils.FindLast(3))
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
wb.Saved = True
wb.Close SaveChanges:=False
End Sub
I have found that the sheet I was importing from the other workbook had external connections and was creating Connections and new References in my Workbook. Don't know why, but somehow this was affecting my Excel and causing it to restart since I was copying all the sheet content.
Instead of copying the full source sheet to my workbook...
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
I copied only the values and formats of the source sheet...
Dim rDestinationRange As Range
'the rest of the code in question
rFullRangeToPaste.Copy wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
Set rDestinationRange = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp)
rFullRangeToPaste.Copy
wsDestination.PasteSpecial xlPasteValuesAndNumberFormats
Note: This worked after my workbook recovered from the previous extraction (without broken external connections and null references). Then I made the changes in the code and save it.
new and would like to ask if someone could possibly check my code to see where i'm making a mistake.
first, i've created a form with two textboxes and two buttons that will go and get two different directories and the associated files. this is done through a call to a function that loads the dir to the textboxes.
a button to call a function to navigate dir and get the file
Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub
function to get workbooks into textboxes 1 and 2:
Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
On Error GoTo exit_
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
workbookFilePath1 = Dir(fileNamePath1)
'TextBox1.Text = workbookFilePath1
TextBox1.Value = fileNamePath1
fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
workbookFilePath2 = Dir(fileNamePath2)
TextBox2.Value = fileNamePath2
If fileNamePath1 = False Or fileNamePath2 = False Then
MsgBox ("File selection was canceled.")
Exit Function
End If
End If
exit_:
End Function
up to here, the code is ok... can do better, but
here's where problems occur... i'd like to pass the directories as objects into the module to diff
button that executes module to diff:
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
i know that i've changed myPath1 and myPath2 to Workbooks, where I've had them as strings before
diffing module
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2
Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet
Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True
Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)
Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add
While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
myWorksheetCounter = ActiveWorkbook.Worksheets.count
myWorksheetCount = ActiveWorkbook.Worksheets.count
If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)
For myWorksheetCounter = i To WorksheetObj1
For myWorksheetCount = j To WorksheetOjb2
'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
Else
cell.Interior.ColorIndex = 0
End If
Next
'if doesn't work... use SaveChanges = True
myNewWorksheetObj.Workbooks.Save() = True
Next
Else
MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
End If
Wend
Set myExcelObj = Nothing
End Sub
So my question is... can someone please assist in seeing where i'm going wrong? essentially, i'm having some issues in trying to get this working.
much appreciated
i've gone through and cleaned up some areas a little bit... but now have a: "run time error '438': object doesn't support this propety or method" at the while loop code that i've updated the post with
I see a typo on CommandButton1_Click
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
There might be something more, but your not capitalizing the "T" in getThe, but you call it that way.