Cannot rename excel file - vb.net

Imports System
Imports System.IO
Imports Microsoft.VisualBasic.FileIO
Imports Microsoft.Office.Interop
Module Program
Dim oxl As Excel.Application
Dim owbs As Excel.Workbooks
Dim owb As Excel.Workbook
Dim osheets As Excel.Worksheets
Dim osheet As Excel.Worksheet
Dim owr As Excel.Range
Dim tempName As String
Sub Main()
oxl = CreateObject("Excel.Application")
oxl.Visible = False
Dim path As String = "G:\Matthews Asia\Matthews Raw Data"
Dim names As String() = Directory.GetFiles(path, "*.xlsx")
Dim newDetails(,) As Object
'Get the new names and the boundaries of the data set
newDetails = getNewNames(names)
'Printing the detials to check getNewNames works or not - works fine
printNewDetails(newDetails) 'Working fine
'Rename files
rename(names, newDetails)
Console.ReadLine()
End Sub
Function getNewNames(ByVal names() As String) As Object(,)
'Declare Object type array to be returned with the details
Dim newDetails(names.Length - 1, 2) As Object
Dim lastRow, lastColumn As Integer
For i =0 To names.GetUpperBound(0)
'point to the excel file
owb = CType(oxl.Workbooks.Open(names(i)), Excel.Workbook) 'Sometimes error comes here
osheet = CType(owb.Worksheets("Holdings"), Excel.Worksheet)
owr = CType(osheet.Range("A7"), Excel.Range)
'Pick new name of file and add the excel extension
tempName = CStr(owr.Value) & ".xlsx"
'row & column number of last data point in the dataset
lastColumn = CType(osheet.Range("A13").End(Excel.XlDirection.xlToRight), Excel.Range).Column
lastRow = CType(osheet.Range("A13").End(Excel.XlDirection.xlDown), Excel.Range).Row
newDetails(i, 0) = tempName
newDetails(i, 1) = lastRow
newDetails(i, 2) = lastColumn
Next
owb.Close()
Return newDetails
End Function
Function printNewDetails(ByVal details As Object(,)) As Integer
For i = 0 To details.GetUpperBound(0)
Console.WriteLine("New name: {0}", details(i, 0))
Console.WriteLine("Last row: {0}", details(i, 1))
Console.WriteLine("Last Column: {0}", details(i, 2))
Next
Return 1
End Function
Sub rename(ByVal oldName As String(), ByVal tempArray As Object(,))
For i = 0 To oldName.GetUpperBound(0)
FileSystem.RenameFile(oldName(i), CStr(tempArray(i, 0))) 'Error Here
Next
End Sub
End Module
i am trying to rename some excel files all of which is in a particular directory. The code does the following:
It opens each file which has just one sheet
Then it picks the string in cell A7 in each of those files
It also finds out the last row and last column of the data set (cell A13 is the starting point of the dataset in each of the files)
Finally, in an object array newDetails we store the string in cell A7 in the first column, the last row of the dataset (column 2) and last column of the dataset (column 3). Each row has data corresponding to one excel file
After that, the code renames the files using the rename subroutine -- the idea is to swap the old names which is stored in the names array with the string value in the first column of the newDetails array.
But When I run the code, the following error message comes: The process cannot access the file because it is being used by another process. I have opened task manager, manually closed all excel processes and even restarted the computer - even then this error comes. Have attached the screenshot of the error. Requesting help.
Strangely, when I run the code more than once, sometimes I am getting the error in the line owb = CType(oxl.Workbooks.Open(names(i)), Excel.Workbook) and that error warns me to check if the files are corrupted or not. The files are not corrupted because when I manually open them there is no problem.

When a filename starts with ~$, it usually indicates that the file is already open (in Excel). However, sometimes this file doesn't get deleted. If you're sure that Excel is no longer running, such as after a reboot, and such a file exists, one can delete it. Of course, one could also just ignore it when getting a list of files.
You haven't mentioned if you're using .NET or .NET Framework and which version. VS 2019 supports .NETCore 3.1, .NET 5 (no longer supported), and .NET Framework versions.
One may consider using NuGet package DocumentFormat.OpenXml or ClosedXml instead. However, if one desires to use Excel Interop, try the following:
Add a reference: Microsoft Excel xx.x Object Library (ex: Microsoft Excel 16.0 Object Library)
Project
Add Project Reference...
COM
Microsoft Excel xx.x Object Library (ex: Microsoft Excel 16.0 Object Library)
OK
Create a class (name: XLInfo.vb)
Public Class XLInfo
Public Property OriginalFilename As String
Public Property LastRow As Integer
Public Property LastColumn As Integer
Public Property RenamedTo As String
End Class
Create a module (name: HelperExcel.vb)
Imports Microsoft.Office.Interop
Imports System.IO
Module HelperExcel
Private Function GetExcelFilenames(folderPath As String) As List(Of String)
Dim filenames As List(Of String) = New List(Of String)
For Each fqFilename As String In Directory.GetFiles(folderPath, "*.xlsx")
'get only the filename
Dim fn As String = Path.GetFileName(fqFilename)
If Not fn.StartsWith("~") Then
Debug.WriteLine($"Info: adding '{fqFilename}'...")
filenames.Add(fqFilename) 'add
End If
Next
Return filenames
End Function
Public Function ProcessExcelFiles(folderPath As String) As List(Of XLInfo)
#Disable Warning CA1416
Dim infos As List(Of XLInfo) = New List(Of XLInfo)
Dim oxl As Excel.Application = Nothing
Dim owbs As Excel.Workbooks = Nothing
Dim owb As Excel.Workbook = Nothing
Dim osheets As Excel.Worksheets = Nothing
Dim osheet As Excel.Worksheet = Nothing
Dim owr As Excel.Range = Nothing
'get filenames
Dim names As List(Of String) = GetExcelFilenames(folderPath)
Try
'create new instance
oxl = New Excel.Application()
oxl.Visible = False
For i As Integer = 0 To names.Count - 1
'create new instance
Dim info As XLInfo = New XLInfo()
'create reference
Dim fn As String = names(i)
'set value
info.OriginalFilename = fn
'open workbook
'owb = oxl.Workbooks.Open(Filename:=fn, [ReadOnly]:=True)
owb = oxl.Workbooks.Open(Filename:=fn)
'open worksheet
osheet = owb.Worksheets(1)
'set value - this is the new filename
info.RenamedTo = Path.Combine(Path.GetDirectoryName(fn), $"{osheet.Range("A7").Value.ToString()}.xlsx")
'ToDo: get last column
'set value - last column
'info.LastColumn = DirectCast(osheet.Range("A13").End(Excel.XlDirection.xlToRight), Excel.Range).Column
'ToDo: get last row
'set value - last row
'info.LastRow = DirectCast(osheet.Range("A13").End(Excel.XlDirection.xlDown), Excel.Range).Row
'add
infos.Add(info)
If osheet IsNot Nothing Then
'release all resources
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(osheet)
'set value
osheet = Nothing
End If
If owb IsNot Nothing Then
'save
owb.SaveCopyAs(info.RenamedTo)
'owb.SaveAs2(Filename:=info.RenamedTo)
'close
owb.Close(False)
'release all resources
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(owb)
'set value
owb = Nothing
End If
Next
Finally
If osheet IsNot Nothing Then
'release all resources
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(osheet)
'set value
osheet = Nothing
End If
If owb IsNot Nothing Then
'close
owb.Close(False)
'release all resources
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(owb)
'set value
owb = Nothing
End If
If oxl IsNot Nothing Then
'quit
oxl.Quit()
'release all resources
System.Runtime.InteropServices.Marshal.FinalReleaseComObject(oxl)
'force garbage collection
GC.Collect()
End If
End Try
#Enable Warning CA1416
'sleep
System.Threading.Thread.Sleep(250)
'delete original filenames
If Not Directory.Exists(Path.Combine(folderPath, "Original Files")) Then
'create folder if it doesn't exist
Directory.CreateDirectory(Path.Combine(folderPath, "Original Files"))
End If
For i As Integer = 0 To names.Count - 1
If File.Exists(names(i)) Then
'move file to .\Original Files\<filename>
File.Move(names(i), Path.Combine(folderPath, "Original Files", Path.GetFileName(names(i))), True)
Debug.WriteLine($"File moved to '{Path.Combine(folderPath, "Original Files", Path.GetFileName(names(i)))}'")
'ToDo: if one desires to delete the original filenames,
'uncomment the line below
'delete file
'File.Delete(names(i))
End If
Next
Return infos
End Function
End Module
Note: The code above was tested with VS 2022 (.NET 6) since .NET 5 is no longer supported. See here for more info. If using .NET Framework, one can remove #Disable Warning CA1416 and #Enable Warning CA1416.
Usage:
Sub Main(args As String())
'ToDo: replace folder name with desired folder name
Dim infos As List(Of XLInfo) = ProcessExcelFiles("C:\Temp")
For Each info As XLInfo In infos
Dim msg As String = $"OriginalFilename: '{info.OriginalFilename}' RenamedTo: '{info.RenamedTo}' LastRow: '{info.LastRow}' LastColumn: '{info.LastColumn}'"
Debug.WriteLine(msg)
Console.WriteLine(msg)
Next
End Sub
Resources:
Excel Interop
What is .NET Framework
Microsoft .NET Framework
Microsoft .NET and .NET Core
System.IO.File
System.IO.Path
Interpolated Strings (Visual Basic Reference)
Collections (Visual Basic)
Objects and classes in Visual Basic
Option Strict Statement
Additional Resources
Programmatically getting the last filled excel row using C#

Related

Copy emails from source folder if not existing in destination folder

I'm using Visual Studio to build an addin to copy emails.
The condition is to check, according to SentOn/ReceivedTime, and copy only those emails from the source folder that do not exist in the destination folder.
I tried below code but its gives me an error System.OutOfMemoryException Out of memory or system resources.
Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
Dim sMail As Object
Dim dMail As Object
Dim MailC As Object
For Each sMail In SourceFolder.Items
For Each dMail In DestinationFolder.Items
If sMail.SentOn <> dMail.SentOn Then
MailC = sMail.Copy
MailC.Move(DestinationFolder)
End If
Next
Next
End Sub
There is a logic error in your nested loop - for each item in the destination folder you copy all non-matches from the source folder, even though those items may match other items in the destination folder.
Here's an approach (untested) which should work.
It's in VBA: my VB.NET is not good and anyway you tagged with VBA...
Sub CopyMail(SourceFolder As Outlook.Folder, DestinationFolder As Outlook.Folder)
Dim sMail As Object
Dim dMail As Object
Dim MailC As Object
Dim dictSent As New Scripting.dictionary, i As Long
'get a list of all unique sent times in the
' destination folder
For Each dMail In DestinationFolder.Items
dictSent(dMail.SentOn) = True
Next
'loop through the source folder and copy all items where
' the sent time is not in the list
For i = SourceFolder.Items.Count To 1 Step -1
Set sMail = SourceFolder.Items(i)
If Not dictSent.Exists(sMail.SentOn) Then
Set MailC = sMail.Copy 'copy and move
MailC.Move DestinationFolder
dictSent(sMail.SentOn) = True 'add to list
End If
Next i
End Sub

How Do I Use the Excel Function LoadPicture() from a Windows Form Application

I have a Windows Form application that my company uses to access all it's reports. Most of the reports are given to the user in an Excel sheet that is created at run-time either from scratch or an Excel Template. This has been working fine for everything up until now. The problem I am running into now is that I need to load an ImageBox on the Excel Template with an image saved on the drive. I have the filepath of the image (this will change each time this run). The only way I have found to be able to set the picture property of the ImageBox is like this...
Dim FileStr As String = "C:\Folder\ImageFile.jpg"
xlWorksheet.ImageName.Picture = LoadPicture(FileStr)
The problem is I can't figure out how to call the LoadPicture() function from within the windows form. I know I could create an Excel Module at run-time that call the LoadPicture() then delete it, but i just figured there had to be a better way? Hoping someone out there has suggestions. Thanks.
Edit:- Here is an example of the code I am Using to Open The Excel Sheet
Imports ExcelVB = Microsoft.Office.Interop.Excel
Imports ad = GartnerInterface.AdminClass.AdminTools
Imports xl = GartnerInterface.AdminClass.XlHelp
Public Class TestClass
Public Shared Sub NewSub()
Dim xlApp As ExcelVB.Application
Dim xlWorkbook As ExcelVB.Workbook
Dim xlWorksheet As ExcelVB.Worksheet
Dim TestSht As String
TestSht = "H:\Josh\ExcelTest.xlsm"
xlApp = CreateObject("Excel.Application")
xlWorkbook = xlApp.Workbooks.Add(TestSht)
xlApp.DisplayAlerts = False
xlApp.Visible = True
xlWorksheet = xlApp.Sheets("Sheet1")
Dim FileStr As String = "H:\12117\12117_Original.png"
'xlWorksheet.RFQImg.Picture = LoadPicture(FileStr)
End Sub
End Class
Now that I'm looking at the code, you would likely need the .AddPicture method
At the bottom of this code, you would need something like the following:
Dim FileStr As String = "H:\12117\12117_Original.png"
xlWorksheet.Shapes.AddPicture(FileStr, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 50, 50, 300, 45)
Taken from,
https://msdn.microsoft.com/en-us/library/office/ff198302.aspx
OR, if you have a template where the image is already named "test"
Dim FileStr As String = "H:\12117\12117_Original.png"
Dim imgName as String = "test"
For Each myShape In xlWorksheet.Shapes
If myShape.Name = imgName then
cTop = myShape.ShapeRange.Top 'we must save the values here
cLeft = myShape.ShapeRange.Left
cHeight = myShape.ShapeRange.Height
cWidth = myShape.ShapeRange.Width
myShape.delete
Exit For
end if
next
xlWorksheet.Shapes.AddPicture(FileStr, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, cLeft, cTop, cWidth, cHeight)
An example, with user interaction, I borrowed from

How to transfer a data table in VB.NET to Excel

I have a data table in VB.net that I am trying to send to a specific range in an Excel spreadsheet. However, upon running the program I get the error:
An exception of type 'System.Runtime.InteropServices.COMException' occurred in MeasurementFinder.dll but was not handled in user code
Additional information: Exception from HRESULT: 0x800A03EC
The error alerts on the following sub:
Private Sub WriteDataTableToRng(targetWs As Excel.Worksheet, anchor As Excel.Range, tbl As System.Data.DataTable)
'This sub writes the given tbl to the targetWs as a range with its top left cell acting as anchor
Dim wRange As Excel.Range = anchor 'wRange = write range. This range represents the cell being written to over every iteration
For Each colm As DataColumn In tbl.Columns 'This loop writes the column names into the target ws
targetWs.Range(wRange).Value2 = colm.ColumnName '**THIS LINE IS CALLED OUT BY THE ERROR
wRange = wRange.Offset(0, 1)
Next colm
wRange = anchor.Offset(1, 0)
For Each row As DataRow In tbl.Rows
For Each col As DataColumn In tbl.Columns
targetWs.Range(wRange).Value2 = tbl.Rows.Item(tbl.Rows.IndexOf(row)).Item(tbl.Columns.IndexOf(col)) '**THIS LINE IS CALLED OUT BY THE SAME ERROR IF THE PREVIOUS LOOP IS COMMENTED OUT
Next col
Next row
End Sub
The sub that calls the previous one is:
Private Sub ReportOnTube(TubeID As Integer)
'This sub creates an Excel workbook that acts as a report on a tube, given its ID
'The report has a worksheet for each measurement tied to the tube (From the Gauge DB)
'Verify the tube is in the DB
Dim TubeExists As Boolean
TubeExists = VerifyTube(TubeID)
If TubeExists Then
'Create a new excel workbook and name/time stamp it
Dim wb As Excel.Workbook = Me.Application.Workbooks.Add()
wb.SaveAs("C:\Gauge Reports\Tube " & TubeID & System.DateTime.Now.ToString(" HH_mm_ss dd-MM-yyyy"))
'Add a worksheet for each measurement tied to the tube
Dim ws As Excel.Worksheet
ws = wb.Worksheets.Add
Dim aRng As Range
aRng = ws.Range("B2")
TubesConn.Close()
TubesConn.Open()
Dim selectTbl As New SqlCommand("SELECT * FROM [Tubes]", TubesConn)
Dim rdr As SqlDataReader
Dim aTbl As New System.Data.DataTable
rdr = selectTbl.ExecuteReader()
aTbl.Load(rdr)
Call WriteDataTableToRng(ws, aRng, aTbl)
TubesConn.Close()
End If
End Sub
I am using the following imports:
Imports System.Data.Sql
Imports System.Data.SqlClient
Imports System.Data
Imports System.IO
Imports Microsoft.Office.Interop.Excel
What I intend to do is iterate through the given data table and write the values in the table to a range in the spreadsheet whose top left corner is given by the "anchor" range variable. I have no warnings from Visual Stuio's IntelliSense, so I don't really know where to start with this one.
Thanks in advance!
targetWs.Range(wRange).Value2 = colm.ColumnName is redundant/wrong. The excel range object stored in wRange is already a property of the worksheet in which it's contained.
In other words, if you have it print out wRange.Parent.Name you will get the worksheet that the range is in. You can't have a range point to two different worksheets (well maybe through like a range union, I've never tried, but who would do that anyway, you probably can't do it... </streamOfConciousness>)
Instead, just use:
wrange.value = colm.columnName

Loop through excel workbooks in vb.net

I am working with a folder of xls files that are all in identical format (automatically generated by entering numbers into a pricing app). I need to pull the data that is in cell D54 on the worksheet of the same name in every file. Can't seem to get anything to work to make it loop.
Any ideas how this can be done?
If you can have the files generated in XLSX format then this is what I would do.
http://epplus.codeplex.com/
This is an amazing component library for dealing with Excel XLSX sheets.
Example...
Sub temp()
Dim out As New List(Of String)
Using pac As New ExcelPackage(New IO.FileInfo("c:\temp.xlsx"))
For Each wb As ExcelWorksheet In pac.Workbook.Worksheets
out.Add(wb.Cells("D54").Value.ToString)
Next
End Using
End Sub
Otherwise the option is to reference the Excel Com+ Library from office to open an XLS sheet with what should be similar code as below.
Sub temp2()
Dim out As New List(Of String)
Dim app As New Microsoft.Office.Interop.Excel.Application
app.DisplayAlerts = False
Dim wb As Microsoft.Office.Interop.Excel.Workbook = app.Workbooks.Open("c:\temp.xls")
For Each ws As Microsoft.Office.Interop.Excel.Worksheet In wb.Worksheets
Dim r As Microsoft.Office.Interop.Excel.Range = ws.Cells(54, 4)
out.Add(r.Value.ToString)
Next
app.close()
End Sub

Reading excel files in vb.net leaves excel process hanging

The following code works fine but seems to leave instances of excel.exe running in the background. How do I go about closing out this sub properly?
Private Sub ReadExcel(ByVal childform As Fone_Builder_Delux.frmData, ByVal FileName As String)
' In progress
childform.sampleloaded = False
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Open(FileName)
xlWorkSheet = xlWorkBook.Worksheets(1)
Dim columnrange = xlWorkSheet.Columns
Dim therange = xlWorkSheet.UsedRange
childform.datagridHeaders.Columns.Add("", "") ' Super imporant to add a blank column, could improve this
For cCnt = 1 To therange.Columns.Count
Dim Obj = CType(therange.Cells(1, cCnt), Excel.Range)
childform.datagridSample.Columns.Add(Obj.Value, Obj.Value)
childform.datagridHeaders.Columns.Add(Obj.Value, Obj.Value)
Next
For rCnt = 2 To therange.Rows.Count
Dim rowArray(therange.Columns.Count) As String
For cCnt = 1 To therange.Columns.Count
Dim Obj = CType(therange.Cells(rCnt, cCnt), Excel.Range)
Dim celltext As String
celltext = Obj.Value.ToString
rowArray((cCnt - 1)) = celltext
'MsgBox(Obj.Value)
Next
childform.datagridSample.Rows.Add(rowArray)
Next
AdjustHeaders(childform)
childform.sampleloaded = True
End Sub
Short answer: close each item appropriately, then call FinalReleaseComObject on them.
GC.Collect()
GC.WaitForPendingFinalizers()
If xlWorkSheet Is Nothing Then Marshal.FinalReleaseComObject(xlWorkSheet)
If xlWorkBook Is Nothing Then
xlWorkBook.Close(false, false)
Marshal.FinalReleaseComObject(xlWorkBook)
End If
xlApp.Quit()
Marshal.FinalReleaseComObject(xlApp)
Long answer: read this answer to another question (the entire post is helpful too).
I ran into this problem and what I found worked was making sure I called the Close() method on all Workbook and Workbooks objects, as well as the Quit() method on the Excel Application object. I also call System.Runtime.InteropServices.Marshal.ReleaseComObject on every Excel object was instantiated. I do all this in reverse order of age, so the newest object gets cleaned up first and the oldest, which is the Application object, gets taken care of last. I don't know if the order really matters, but it seems like it might.
I've seen examples where GC.Collect() was called at the very end, but I've never had to do that to get the excel.exe process to end.