Hi is there a way to transfer access database with image to excel ? Since my image using ole object.
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
If DataGridView1.RowCount = Nothing Then
MessageBox.Show("Sorry nothing to export into excel sheet.." & vbCrLf & "Please retrieve data in datagridview", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
Exit Sub
End If
Dim rowsTotal, colsTotal As Short
Dim I, j, iC As Short
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
Dim xlApp As New excel.Application
Try
Dim excelBook As excel.Workbook = xlApp.Workbooks.Add
Dim excelWorksheet As excel.Worksheet = CType(excelBook.Worksheets(1), excel.Worksheet)
xlApp.Visible = True
rowsTotal = DataGridView1.RowCount - 1
colsTotal = DataGridView1.Columns.Count - 1
With excelWorksheet
.Cells.Select()
.Cells.Delete()
For iC = 0 To colsTotal
.Cells(1, iC + 1).Value = DataGridView1.Columns(iC).HeaderText
Next
For I = 0 To rowsTotal - 1
For j = 0 To colsTotal
.Cells(I + 2, j + 1).value = DataGridView1.Rows(I).Cells(j).Value
.Shapes.AddPicture("C:\pic.jpg", MsoTristate.msofalse, msotristate.msoCTrue, 50, 50, 300, 45) <-I just add this to transfer the image
Next j
Next I
.Rows("1:1").Font.FontStyle = "Bold"
.Rows("1:1").Font.Size = 12
.Cells.Columns.AutoFit()
.Cells.Select()
.Cells.EntireColumn.AutoFit()
.Cells(1, 1).Select()
End With
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
'RELEASE ALLOACTED RESOURCES
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
xlApp = Nothing
End Try
End Sub
If the data doesnt have any picture then it can be transfered but with image it just not working... I been following some walkthrough and i just add that code to allow picture transfer.
The imports thst i use:
Imports system.data.oledb
Imports microsoft.office.core
imports excel = microsoft.office.interop.excel
Related
I created an app that does the following:
Opens an excel spreadsheet and show a hidden sheet
Copy the data in this sheet to a temporary spreadsheet
Run some error checks on the data that's been pasted
Create a unique code in the first column based on customer no. date & time
Save the spreadsheet as a new file
Clear up to be ready for the next spreadsheet
The problem I am having is at step 6 of clearing up and releasing any excel objects in memory that can hold up moving to the next spreadsheet and so on.
The current issue I have is that an Excel object remains open and locks the tempfile.xlsx that is created which will then randomly generates the error "The file 'C:\Temp\CustOrders\Input\TempFile.xlsx' already exists." I say randomly because I can run 10 or more files through it without an issue. I could run them all again and it will produce the error after the 1st, 2nd, 3rd or later file. I cannot blame any one file for causing this.
How do I effectively close out all Excel objects ready for the next file to be processed? I have so far tried different ways to do this including trying to kill the process but this seems like a dirty sledgehammer approach.
Here's the code:
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Imports System.IO
Public Class Form1
Dim xlApp As Excel.Application
Dim xlNewApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim range As Excel.Range
Dim rCnt As Integer
Dim cCnt As Integer
Dim Obj As Object
Dim TempFile() As String
Dim TempFiledir As String
Dim filename As String
Dim xlNewWorkBook As Excel.Workbook
Dim xlNewWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim Cust As Object
Dim pfile As String
Dim NoProcessed As Integer = 0
Dim NoFailed As Integer = 0
Dim filecount As Integer = 0
Dim fileremaining As Integer = 0
Dim custFailed As Integer = 0
Dim files() As String = Directory.GetFiles("C:\Temp\CustOrders\Uploaded")
Dim di As New DirectoryInfo("C:\Temp\CustOrders\Uploaded")
Private Sub releaseObject(ByVal obj As Object)
Try
Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
lblProcessingFile.Visible = False
CountFiles()
lblFileCount.Text = "Files to be processed: " & filecount
End Sub
Function CountFiles()
Dim files() As String = Directory.GetFiles("C:\Temp\CustOrders\Uploaded")
Dim di As New DirectoryInfo("C:\Temp\CustOrders\Uploaded")
If files.Count > 0 Then
filecount = di.GetFiles("*.xlsx").Count()
Else
filecount = 0
lblFileCount.Text = "Files to be processed: " & filecount
End If
End Function
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles BTN_gencsv.Click
TempFiledir = ("C:\Temp\CustOrders\Input\TempFile.xlsx")
If My.Computer.FileSystem.FileExists(TempFiledir) Then
My.Computer.FileSystem.DeleteFile(TempFiledir)
End If
GetFiles()
End Sub
Sub GetFiles()
'1. Look in the UPLOADED folder for new files
Dim files() As String = Directory.GetFiles("C:\Temp\CustOrders\Uploaded")
Dim di As New DirectoryInfo("C:\Temp\CustOrders\Uploaded")
If files.Count > 0 Then
Dim arrayfi As FileInfo() = di.GetFiles("*.xlsx")
Dim fi As FileInfo
For Each fi In arrayfi
filename = fi.Name
Start(filename)
Next
Else
MsgBox("No files available in directory")
End If
End Sub
Sub Start(filename)
With BTN_gencsv
.BackColor = Color.Red
.ForeColor = Color.White
.Text = "Please wait..."
End With
'2. Get the file that has been uploaded by the customer, copy and rename as TempFile
lblProcessingFile.Visible = True
lblProcessingFile.Text = "Processing file: " & filename
IO.File.Copy("C:\Temp\CustOrders\Uploaded\" & filename, _
"C:\Temp\CustOrders\Input\TempFile.xlsx")
xlApp = New Excel.Application
xlNewApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open("C:\Temp\CustOrders\Input\TempFile.xlsx")
xlWorkSheet = xlWorkBook.Worksheets(1)
xlWorkSheet = xlWorkBook.Worksheets("CSV")
xlWorkSheet.Visible = XlSheetVisibility.xlSheetVisible
xlWorkSheet.Unprotect("opencsv")
'3. Copy rows from the CSV worksheet including headers
xlWorkSheet.Range("A1:H100").Copy()
'4. Create new Excel workbook and worksheet so it can have have all rows pasted in
' Then perform all prep work
xlNewWorkBook = xlNewApp.Workbooks.Add(misValue)
xlNewWorkSheet = xlNewWorkBook.Worksheets(1)
xlNewWorkSheet.Select()
' Paste the rows into the new worksheet
On Error Resume Next
xlNewWorkSheet.PasteSpecial(Excel.XlPasteType.xlPasteValues)
xlApp.CutCopyMode = False
' Get current date/time
Dim dt As DateTime = DateTime.Now
Dim dt2 As String = dt
dt2 = dt2.Replace("/", "").Replace(" ", "_").Replace(":", "")
' Select customer number from worksheet
Dim xRng As Excel.Range = CType(xlNewWorkSheet.Cells(2, 5), Excel.Range)
Cust = xRng.Value().ToString()
' If the customer is not found in the spreadsheet lookup it generates "-2146826246" as a value
' This saves the cell as "Not found" to make it look friendly
If Cust.Equals("-2146826246") Then
custFailed += 1
Cust = "Cust_Not_Found_" & custFailed
failedfiles()
Else
CustNo()
End If
releaseObject(xRng)
' This now passes to two error checking subs
End Sub
Sub completeform()
'5. Generate a unique value for Netsuite based on the customer number and current date time
Dim Row As Range
Dim Index As Long
Dim Count As Long
For Index = xlNewWorkSheet.UsedRange.Rows.Count To 1 Step -1
Row = xlNewWorkSheet.UsedRange.Rows(Index)
Count = 0
On Error Resume Next
Count = Row.SpecialCells(XlCellType.xlCellTypeBlanks).Count
If Count = Row.Cells.Count Then Row.Delete(Excel.XlDirection.xlUp)
Next
Dim dt As DateTime = DateTime.Now
Dim dt2 As String = dt
dt2 = dt2.Replace("/", "").Replace(" ", "_").Replace(":", "")
pfile = (Cust + "_" + dt2)
Dim rw As Integer = 1
Do Until xlNewWorkSheet.Cells(rw, 1).Value Is Nothing
rw += 1
Loop
Dim last As String = rw - 1
With xlNewWorkSheet.Range("A1:A100")
.Range(.Cells(2, 1), .Cells(last, 1)).Value = (Cust + "_" + dt2)
End With
'6. Save the workbook with a unique name based on customer number and date/time
xlWorkBook.Saved = True
xlNewWorkBook.SaveAs("C:\Temp\CustOrders\Output\Test_" + pfile + ".csv", Excel.XlFileFormat.xlCSV, misValue, misValue, misValue, misValue, _
Excel.XlSaveAsAccessMode.xlExclusive, misValue, misValue, misValue, misValue, misValue)
'7. Close and release all Excel worksheets and workbooks so they dont remain in memory
xlNewWorkBook.Close(True, misValue, misValue)
xlWorkBook.Saved = True
xlNewWorkBook.Saved = True
releaseObject(xlNewWorkSheet)
releaseObject(xlNewWorkBook)
releaseObject(xlNewApp)
xlWorkBook.Close(False)
xlApp.Quit()
releaseObject(range)
releaseObject(xlWorkSheet)
releaseObject(xlWorkBook)
releaseObject(xlApp)
xlNewApp.Quit()
System.Threading.Thread.Sleep(2000)
'8. Move the processed workbook to the Processed folder ready for a new workbook
IO.File.Move("C:\Temp\CustOrders\Input\TempFile.xlsx", _
"C:\Temp\CustOrders\Processed\Processedfile_" + pfile + ".xlsx")
'9. Move the spreadsheet from Uploaded to OldUploaded ready for a new file
IO.File.Move("C:\Temp\CustOrders\Uploaded\" + filename, _
"C:\Temp\CustOrders\OldUploaded\Uploaded_" + filename)
NoProcessed += 1
lblProcessedCount.Text = "No. Processed..." & NoProcessed
CountFiles()
lblFileCount.Text = "Files to be processed: " & filecount
With BTN_gencsv
.BackColor = SystemColors.Control
.ForeColor = SystemColors.ControlText
.Text = "Generate CSV"
End With
lblProcessingFile.Visible = False
End Sub
Sub CustNo()
Dim c As Range
With xlNewWorkSheet.Range("A1:A100")
c = .Find("#N/A", LookIn:=XlFindLookIn.xlValues)
If Not c Is Nothing Then
custFailed += 1
Cust = "Cust_Not_Found_" & custFailed
MsgBox(Cust)
failedfiles()
Else
quantityBlanks()
End If
End With
End Sub
Sub quantityBlanks()
Dim rw As Integer = 1
Do Until xlNewWorkSheet.Cells(rw, 1).Value Is Nothing
rw += 1
Loop
Dim last As String = rw - 1
Dim rng As Excel.Range
Dim TotalBlanks As Long
TotalBlanks = 0
rng = xlNewWorkSheet.Range(xlNewWorkSheet.Cells(2, 8), xlNewWorkSheet.Cells(last, 8))
On Error Resume Next
TotalBlanks = rng.SpecialCells(XlCellType.xlCellTypeBlanks).Count
If TotalBlanks > 0 Then
Cust = "Quantity_error_"
failedfiles()
Else
referrors()
End If
rng = Nothing
End Sub
Sub referrors()
Dim c As Range
With xlNewWorkSheet.Range("A1:A100")
c = .Find("#REF!", LookIn:=XlFindLookIn.xlValues)
If Not c Is Nothing Then
Cust = "~REF!_errors_"
failedfiles()
Else
completeform()
End If
End With
End Sub
Sub failedfiles()
Dim dt As DateTime = DateTime.Now
Dim dt2 As String = dt
dt2 = dt2.Replace("/", "").Replace(" ", "_").Replace(":", "")
pfile = (Cust + "_" + dt2)
xlWorkBook.Close(False)
xlNewWorkBook.Close(False)
xlNewApp.Quit()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
releaseObject(xlNewApp)
releaseObject(xlNewWorkBook)
releaseObject(xlNewWorkSheet)
'IO.File.Delete("C:\Temp\CustOrders\Input\Newfile.xlsx")
IO.File.Move("C:\Temp\CustOrders\Input\TempFile.xlsx", _
"C:\Temp\CustOrders\Processed\ProcessedFailedfile_" + pfile + ".xlsx")
IO.File.Move("C:\Temp\CustOrders\Uploaded\" + filename, _
"C:\Temp\CustOrders\Failed\FailedFile_" + pfile + ".xlsx")
With BTN_gencsv
.BackColor = SystemColors.Control
.ForeColor = SystemColors.ControlText
.Text = "Generate CSV"
End With
NoFailed += 1
lblFailed.ForeColor = Color.Red
lblFailed.Text = "No. Failed..." & NoFailed
CountFiles()
lblFileCount.Text = "Files to be processed: " & filecount
lblProcessingFile.Visible = False
End Sub
Private Sub PictureBox1_Click(sender As System.Object, e As System.EventArgs) Handles PictureBox1.Click
CountFiles()
lblFileCount.Text = "Files to be processed: " & filecount
End Sub
End Class
I am trying to export my userform listbox contents to a new workbook.
I am getting the error as I commented in the code.
Private Sub ExportListBoxContents_Click()
Dim xlApp As Excel.Application
Dim xlsh As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Set xlApp = New Excel.Application
xlApp.Workbooks.Add
Set xlsh = xlApp.Workbooks(1).Worksheets(1)
For j = 1 To ListBox1.ListCount
For i = 0 To ListBox1.ColumnCount
xlsh.Cells(j, i).Value = ListBox1.List(j - 1, i) '<----Object defined error
Next i
Next j
xlApp.Visible = True
Set xlsh = Nothing
Set xlApp = Nothing
End Sub
Okay I have managed to solve it after so many hours and searching.
All I had to do is amend the line from this:
xlsh.Cells(j, i).Value = ListBox1.List(j - 1, i)
To this:
xlsh.Cells(j , i).Value = ListBox1.Column(j - 1, i - 1)
I’m using VB.net on Microsoft visual studio 2017, to create a little App and I’m having a problem with the code that I’m using to export my Datagridview to excel. It exports everything but the last row of my data. Any idea how I can fix this?
Imports Excel = Microsoft.Office.Interop.Excel
Imports Microsoft.Office
Imports Microsoft.Office.Interop
Imports System.IO
Private Sub ExportToExcel()
' Creating a Excel object.
Dim excel As Microsoft.Office.Interop.Excel._Application = New Microsoft.Office.Interop.Excel.Application()
Dim workbook As Microsoft.Office.Interop.Excel._Workbook = excel.Workbooks.Add(Type.Missing)
Dim worksheet As Microsoft.Office.Interop.Excel._Worksheet = Nothing
Try
worksheet = workbook.ActiveSheet
worksheet.Name = "ExportedFromDatGrid"
Dim cellRowIndex As Integer = 1
Dim cellColumnIndex As Integer = 1
'Write headers
For j As Integer = 0 To DataGridView_Kontakte.Columns.Count - 2
worksheet.Cells(cellRowIndex, cellColumnIndex) = DataGridView_Kontakte.Columns(j).HeaderText
cellColumnIndex += 1
Next
cellColumnIndex = 1
cellRowIndex += 1
'Loop through each row and read value from each column.
For i As Integer = 0 To DataGridView_Kontakte.Rows.Count - 2
For j As Integer = 0 To DataGridView_Kontakte.Columns.Count - 1
' Excel index starts from 1,1. As first Row would have the Column headers, adding a condition check.
worksheet.Cells(cellRowIndex, cellColumnIndex) = DataGridView_Kontakte.Rows(i).Cells(j).Value.ToString()
cellColumnIndex += 1
Next
cellColumnIndex = 1
cellRowIndex += 1
Next
'Getting the location and file name of the excel to save from user.
Dim saveDialog As New SaveFileDialog()
saveDialog.Filter = "Excel files (*.xlsx)|*.xlsx|All files (*.*)|*.*"
saveDialog.FilterIndex = 2
If saveDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
workbook.SaveAs(saveDialog.FileName)
MessageBox.Show("Export Successful")
End If
Catch ex As System.Exception
MessageBox.Show(ex.Message)
Finally
excel.Quit()
workbook = Nothing
excel = Nothing
End Try
End Sub
You can try my function to export in EXCEL
Sub ExportExcel(ByVal obj As Object)
Dim rowsTotal, colsTotal As Short
Dim I, j, iC As Short
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
Dim xlApp As New Excel.Application
Try
Dim excelBook As Excel.Workbook = xlApp.Workbooks.Add
Dim excelWorksheet As Excel.Worksheet = CType(excelBook.Worksheets(1), Excel.Worksheet)
xlApp.Visible = True
rowsTotal = obj.RowCount
colsTotal = obj.Columns.Count - 1
With excelWorksheet
.Cells.Select()
.Cells.Delete()
For iC = 0 To colsTotal
.Cells(1, iC + 1).Value = obj.Columns(iC).HeaderText
Next
For I = 0 To rowsTotal - 1
For j = 0 To colsTotal
.Cells(I + 2, j + 1).value = obj.Rows(I).Cells(j).Value
Next j
Next I
.Rows("1:1").Font.FontStyle = "Bold"
.Rows("1:1").Font.Size = 12
.Cells.Columns.AutoFit()
.Cells.Select()
.Cells.EntireColumn.AutoFit()
.Cells(1, 1).Select()
End With
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Finally
'RELEASE ALLOACTED RESOURCES
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
xlApp = Nothing
End Try
End Sub
From Datgridview to Excel? It should be done like this.
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
Dim cnn As SqlConnection
Dim connectionString As String
Dim sql As String
connectionString = "data source=servername;" & _
"initial catalog=databasename;user id=username;password=password;"
cnn = New SqlConnection(connectionString)
cnn.Open()
sql = "SELECT * FROM Product"
Dim dscmd As New SqlDataAdapter(sql, cnn)
Dim ds As New DataSet
dscmd.Fill(ds)
DataGridView1.DataSource = ds.Tables(0)
cnn.Close()
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
DataGridView1(j, i).Value.ToString()
Next
Next
xlWorkSheet.SaveAs("C:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("You can find the file C:\vbexcel.xlsx")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
Please see the link below for all relevant information, and several relater links as well.
http://vb.net-informations.com/excel-2007/vb.net_export_from_datagridview_to_excel.htm
I have a DataGridView and a button that exports the values of the DataGridView to excel. The question is how can I set the values to non editable or read only when it is sent to the excel? And what is the code to set the default cell sizes of the value where it will be displayed?
Here is my code of the Button:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim App_xls As Object
Dim Lig_cpt, Col_cpt As Integer
App_xls = CreateObject("Excel.Application")
App_xls.workbooks.add()
App_xls.visible = True
Try
For Col_cpt = 0 To DataGridView1.ColumnCount - 1
App_xls.ActiveSheet.cells(1, Col_cpt + 1).value = DataGridView1.Columns(Col_cpt).HeaderText
Next
For Lig_cpt = 0 To DataGridView1.Rows.Count - 1
For Col_cpt = 0 To DataGridView1.ColumnCount - 1
If IsNumeric(DataGridView1.Item(Col_cpt, Lig_cpt).Value) Then
App_xls.ActiveSheet.cells(Lig_cpt + 2, Col_cpt + 1).value = CDbl(DataGridView1.Item(Col_cpt, Lig_cpt).Value)
Else
App_xls.ActiveSheet.cells(Lig_cpt + 2, Col_cpt + 1).value = DataGridView1.Item(Col_cpt, Lig_cpt).Value
End If
Next
Next
Catch ex As Exception
End Try
End Sub
`
By default all cells are set as not editable (locked) for a worksheet. But the feature becomes active only when the sheet is protected. Optionally you can set also a password for protection.
The function that can be used for this purpose is Excel.Worksheet.Protect.
If you need any cells to be editable, you must unlocked those cells.
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
DataGridView1(j, i).Value.ToString()
Next
Next
xlWorkSheet.SaveAs("C:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("You can find the file C:\vbexcel.xlsx")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
To export from DGV to excel, try the script below.
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Data.OleDb
'~~> Define your Excel Objects
Public Class Form1
Private Sub Button3_Click(sender As System.Object, e As System.EventArgs) Handles Button3.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For Each col As DataGridViewColumn In Me.DataGridView1.Columns
xlWorkSheet.Cells(1, col.Index + 1) = col.HeaderText.ToString
Next
Try
For CurrentRowIndex = 0 To DataGridView1.RowCount - 1 'current row index
'For j = 0 To Me.DataGridView1.ColumnCount
For CurrentColumnIndex = 0 To DataGridView1.ColumnCount - 1 'current column index within row index
xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
xlWorkSheet.Cells(CurrentRowIndex + 3, CurrentColumnIndex + 1) = DataGridView1(CurrentColumnIndex, CurrentRowIndex).Value.ToString()
Next
'xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
'xlWorkSheet.Cells(i + 2, j + 1) = Me.DataGridView1(j, i).Value.ToString()
'xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
'Next
Next
Catch ex As Exception
MsgBox("Unable to extract data" & ex.Message, MsgBoxStyle.Critical)
Exit Sub
End Try
xlWorkBook.Activate()
'//get path
Me.FolderBrowserDialog1.ShowDialog()
Dim path As String = Me.FolderBrowserDialog1.SelectedPath
xlWorkBook.SaveAs(path & "\Excel_With_Headers.xls")
'xlWorkSheet.SaveAs("burn permit export.xls")
xlWorkBook.Close()
xlApp.Quit()
'releaseObject(xlApp)
'releaseObject(xlWorkBook)
'releaseObject(xlWorkSheet)
MsgBox("You can find your report at " & path & "\burn permit export.xls")
End Sub
End Class
You can try this as well.
Private Sub Button4_Click(sender As System.Object, e As System.EventArgs) Handles Button4.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
Try
For CurrentRowIndex = 0 To DataGridView1.RowCount - 1 'current row index
'xlWorkSheet.Cells(1, 1) = "With Headers"
For CurrentColumnIndex = 0 To DataGridView1.ColumnCount - 1 'current column index within row index
xlWorkSheet.Cells(2, CurrentColumnIndex + 1) = DataGridView1.Columns(CurrentColumnIndex).HeaderText 'display header
xlWorkSheet.Cells(CurrentRowIndex + 3, CurrentColumnIndex + 1) = DataGridView1(CurrentColumnIndex, CurrentRowIndex).Value.ToString()
Next
Next
Catch ex As Exception
MsgBox("Unable to extract data" & ex.Message, MsgBoxStyle.Critical)
Exit Sub
End Try
End Sub
Can someone explain why my code won't let me save data to Excel unless I include a MsgBox?
Here is my code:
Sub createreport()
Try
Dim XA As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
wb = XA.Workbooks.Open(dataDirectory + "employee_info\dtr_emp.xlsx", False, False, True)
ws = wb.Worksheets("Sheet1")
MsgBox("Test") '<---- THIS IS THE MSGBOX I WAS TALKING ABOUT
For i As Integer = 0 To Me.EmployeeInfoDataGridView.Rows.Count - 1
Dim DGV As DataGridViewRow = Me.EmployeeInfoDataGridView.Rows(i)
ws.Cells(7 + i, 1) = DGV.Cells(0).Value
ws.Cells(7 + i, 2) = DGV.Cells(1).Value
ws.Cells(7 + i, 3) = DGV.Cells(2).Value
ws.Cells(7 + i, 4) = DGV.Cells(3).Value
ws.Cells(7 + i, 5) = DGV.Cells(4).Value
ws.Cells(7 + i, 6) = DGV.Cells(5).Value
ws.Cells(7 + i, 7) = DGV.Cells(6).Value
ws.Cells(7 + i, 8) = DGV.Cells(7).Value
ws.Cells(7 + i, 9) = DGV.Cells(8).Value
ws.Cells(7 + i, 10) = DGV.Cells(9).Value
ws.Cells(7 + i, 11) = DGV.Cells(10).Value
ws.Cells(7 + i, 12) = DGV.Cells(12).Value
ws.Cells(7 + i, 13) = DGV.Cells(14).Value
Next
XA.Visible = False
wb.SaveAs(dataDirectory + "employee_info\temp_" + Form1.lbl_date.Text + ".xlsx")
wb.Close(True)
XA.Quit()
wb = Nothing : ws = Nothing : XA = Nothing
Try
My.Computer.FileSystem.CopyFile("employee_info\temp_" + Form1.lbl_date.Text + ".xlsx", "employee_info\employee_infos.xlsx", True)
My.Computer.FileSystem.DeleteFile("employee_info\temp_" + Form1.lbl_date.Text + ".xlsx", FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently, FileIO.UICancelOption.DoNothing)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Catch ex As Exception
MsgBox(ex.Message)
End Try
exit_excel_process.Show()
End Sub
No data is saved to Excel file unless I put that MsgBox code in.
Since the Try is not working, the focus is getting kicked out to Catch. This seems overly complicated to do it this way. Please see the code sample below. Can you work around that?
Imports System.Data
Imports System.Data.SqlClient
Imports Excel = Microsoft.Office.Interop.Excel
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button1.Click
Dim cnn As SqlConnection
Dim connectionString As String
Dim sql As String
connectionString = "data source=servername;" & _
"initial catalog=databasename;user id=username;password=password;"
cnn = New SqlConnection(connectionString)
cnn.Open()
sql = "SELECT * FROM Product"
Dim dscmd As New SqlDataAdapter(sql, cnn)
Dim ds As New DataSet
dscmd.Fill(ds)
DataGridView1.DataSource = ds.Tables(0)
cnn.Close()
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button2.Click
Dim xlApp As Excel.Application
Dim xlWorkBook As Excel.Workbook
Dim xlWorkSheet As Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
xlApp = New Excel.ApplicationClass
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
xlWorkSheet.Cells(i + 1, j + 1) = _
DataGridView1(j, i).Value.ToString()
Next
Next
xlWorkSheet.SaveAs("C:\vbexcel.xlsx")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("You can find the file C:\vbexcel.xlsx")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class