I am running a code to export a datatable to Excel. Since this is taking a while I dont want to confuse the user and display an image
Dim _excel As New Microsoft.Office.Interop.Excel.Application
Dim wBook As Microsoft.Office.Interop.Excel.Workbook
Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet
PictureLoading.Visible = True
wBook = _excel.Workbooks.Add()
wSheet = wBook.ActiveSheet()
Dim dt As System.Data.DataTable = GetTableForCompleteArchive()
Dim dc As System.Data.DataColumn
Dim dr As System.Data.DataRow
Dim colIndex As Integer = 0
Dim rowIndex As Integer = 0
PictureLoading.Refresh()
For Each dc In dt.Columns
colIndex += 1
_excel.Cells(1, colIndex) = dc.ColumnName
Next
PictureLoading.Refresh()
For Each dr In dt.Rows
rowIndex += 1
colIndex = 0
For Each dc In dt.Columns
colIndex += 1
_excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
Next
Next
PictureLoading.Refresh()
wSheet.Columns.AutoFit()
Dim strFileName As String = Application.StartupPath & "\Export.xlsx" '"C:\datatable.xlsx"
If System.IO.File.Exists(strFileName) Then
System.IO.File.Delete(strFileName)
End If
PictureLoading.Refresh()
wBook.SaveAs(strFileName)
wBook.Close()
_excel.Quit()
PictureLoading.Visible = False
The problem is the image freezes and is not animating. Is there a way to get the image animating while waiting for the process?
Private Sub TotalArchiveToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles EXCELToolStripMenuItem.Click
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
'call this method to start your asynchronous Task.
BackgroundWorker1.RunWorkerAsync()
'display the loading image
PictureLoading.Visible = True
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
'call the function to export to Excel
Export2Excel()
If BackgroundWorker1.CancellationPending Then
e.Cancel = True
End If
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
'' This event is fired when your BackgroundWorker exits.
'' It may have exitted Normally after completing its task,
'' or because of Cancellation, or due to any Error.
PictureLoading.Visible = False
End Sub
My function is run from inside the Backgroundworker_DoWork. The image is set to visible when I click TotalArchiveToolStripMenuItem and set to not visible when the BackgroundWorker is completed.
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’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 want to do a "Save as" in my program in visual Studio but i have a problem...
This is the code where export datagridview to excel :
If ((DataGridView1.Columns.Count = 0) Or (DataGridView1.Rows.Count = 0)) Then
Exit Sub
End If
Dim dset As New DataSet
dset.Tables.Add()
For i As Integer = 0 To DataGridView1.ColumnCount - 1
dset.Tables(0).Columns.Add(DataGridView1.Columns(i).HeaderText)
Next
Dim dr1 As DataRow
For i As Integer = 0 To DataGridView1.RowCount - 1
dr1 = dset.Tables(0).NewRow
For j As Integer = 0 To DataGridView1.Columns.Count - 1
dr1(j) = DataGridView1.Rows(i).Cells(j).Value
Next
dset.Tables(0).Rows.Add(dr1)
Next
Dim excel As New Microsoft.Office.Interop.Excel.Application
Dim wBook As Microsoft.Office.Interop.Excel.Workbook
Dim wSheet As Microsoft.Office.Interop.Excel.Worksheet
wBook = excel.Workbooks.Add()
wSheet = wBook.ActiveSheet()
Dim dt As System.Data.DataTable = dset.Tables(0)
Dim dc As System.Data.DataColumn
Dim dr As System.Data.DataRow
Dim colIndex As Integer = 0
Dim rowIndex As Integer = 0
For Each dc In dt.Columns
colIndex = colIndex + 1
excel.Cells(1, colIndex) = dc.ColumnName
Next
For Each dr In dt.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each dc In dt.Columns
colIndex = colIndex + 1
excel.Cells(rowIndex + 1, colIndex) = dr(dc.ColumnName)
Next
Next
wSheet.Columns.AutoFit()
Dim strFileName As String = "D:\testehorario.xlsx"
Dim blnFileOpen As Boolean = False
Try
Dim fileTemp As System.IO.FileStream = System.IO.File.OpenWrite(strFileName)
fileTemp.Close()
Catch ex As Exception
blnFileOpen = False
End Try
If System.IO.File.Exists(strFileName) Then
System.IO.File.Delete(strFileName)
End If
wBook.SaveAs(strFileName)
excel.Workbooks.Open(strFileName)
excel.Visible = True
and this is the code that does the "Save as":
Dim sfd As New SaveFileDialog() ' this creates an instance of the SaveFileDialog called "sfd"
sfd.Filter = "txt files (*.xlsx)|*.xlsx|All files (*.*)|*.*"
sfd.FilterIndex = 1
sfd.RestoreDirectory = True
If sfd.ShowDialog() = DialogResult.OK Then
Dim FileName As String = sfd.FileName ' retrieve the full path to the file selected by the user
Dim sw As New System.IO.StreamWriter(FileName, False) ' create a StreamWriter with the FileName selected by the User
sw.WriteLine(TextBox1.Text) ' Write the contents of TextBox to the file
sw.Close() ' close the file
End If
How can I export a datagridview to excel and make a Save As ? I have already tried using the "Save as" code in the top code but it gives error...
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
I'm currently working on a program for my company that will be used to communicate various information between users, among other things that aren't important at the moment. One of the things that is going to be communicated is a daily tasks checklist. Basically, the intent is to have a check list that syncs between all users, so if one user checks off a task, everyone else can see that the task has been completed.
So far what I have done is I have created a DataGrid object to hold the check boxes. The box starts empty, but when the program loads, the following code is run, which populates the list.
Private Sub chkListPop()
If System.IO.File.Exists(chkListPath) Then
Dim newChk As CheckBox
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBooks As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim rng As Microsoft.Office.Interop.Excel.Range
Dim r As Byte
xlApp = New Microsoft.Office.Interop.Excel.Application
xlWorkBooks = xlApp.Workbooks.Open(chkListPath)
xlWorkSheet = xlWorkBooks.Worksheets("Tasks")
rng = xlWorkSheet.Range("A2")
r = 0
Do While rng.Offset(r).Value <> ""
chkListContainer.Items.Add(New Controls.CheckBox)
newChk = chkListContainer.Items.Item(r)
newChk.Content = rng.Offset(r).Value
Try
If rng.Offset(r, 1).Value = True Then
newChk.IsChecked = True
End If
Catch
End Try
r = r + 1
Loop
xlApp.DisplayAlerts = False
xlWorkBooks.Save()
xlWorkBooks.Close()
xlApp.DisplayAlerts = True
xlApp.Quit()
End If
End Sub
Basically, the sub reads an excel file and, for each line in the file, creates a checkbox with the true false value in the second column. I imagine there has to be a more elegant solution to do this. I am not a programmer by training, so I have limited knowledge on topics this "complex". Whats a better way to do this other than using an excel file? Should I use an Access database or and SQL database instead? This code works, but I just feel like its wrong somehow.
Additionally, I am having trouble figuring out how to update the file when someone checks off a task. For now I just have a timer running, and every X minutes, the program updates the excel file. Here's the code for how that works:
Public Sub chkListSendData()
If System.IO.File.Exists(chkListPath) Then
Dim newChk As CheckBox
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBooks As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim rng As Microsoft.Office.Interop.Excel.Range
Dim r As Byte
xlApp = New Microsoft.Office.Interop.Excel.Application
xlWorkBooks = xlApp.Workbooks.Open(chkListPath)
xlWorkSheet = xlWorkBooks.Worksheets("Tasks")
rng = xlWorkSheet.Range("A2")
r = 0
Do While rng.Offset(r).Value <> ""
Try
newChk = chkListContainer.Items.Item(r)
Catch
chkListContainer.Items.Add(New Controls.CheckBox)
newChk = chkListContainer.Items.Item(r)
newChk.Content = rng.Offset(r).Value
End Try
If newChk.IsChecked Then
rng.Offset(r, 1).Value = True
End If
r = r + 1
Loop
xlApp.DisplayAlerts = False
xlWorkBooks.Save()
xlWorkBooks.Close()
xlApp.DisplayAlerts = True
xlApp.Quit()
End If
End Sub
Public Sub chkListGetData()
If System.IO.File.Exists(chkListPath) Then
Dim newChk As CheckBox
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBooks As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim rng As Microsoft.Office.Interop.Excel.Range
Dim r As Byte
xlApp = New Microsoft.Office.Interop.Excel.Application
xlWorkBooks = xlApp.Workbooks.Open(chkListPath)
xlWorkSheet = xlWorkBooks.Worksheets("Tasks")
rng = xlWorkSheet.Range("A2")
r = 0
Do While rng.Offset(r).Value <> ""
Try
newChk = chkListContainer.Items.Item(r)
Catch
chkListContainer.Items.Add(New Controls.CheckBox)
newChk = chkListContainer.Items.Item(r)
newChk.Content = rng.Offset(r).Value
End Try
Try
If rng.Offset(r, 1).Value = True Then
newChk.IsChecked = True
End If
Catch
End Try
r = r + 1
Loop
xlApp.DisplayAlerts = False
xlWorkBooks.Close()
xlApp.DisplayAlerts = True
xlApp.Quit()
End If
End Sub
Private Sub chkTimer()
Dim dispatcherTimer As DispatcherTimer = New DispatcherTimer()
AddHandler dispatcherTimer.Tick, AddressOf OnTimedEvent
dispatcherTimer.Interval = New TimeSpan(0, 1, 0)
dispatcherTimer.Start()
End Sub
Private Sub OnTimedEvent(ByVal sender As Object, ByVal e As EventArgs)
chkListGetData()
chkListSendData()
End Sub
In my testing, this has worked fine, but I have a feeling that when lots of people are using the program, this will not work so well when multiple people attempt to update the file at the same time. If I'm wrong and this code is perfect, that's great, but I doubt that is the case. If there's a better way to handle this kind of thing, I would love to learn how to implement it in this program.
Thanks, in advance, for your help.