Skip to content

Instantly share code, notes, and snippets.

@Laicure
Last active October 4, 2019 07:47
Show Gist options
  • Save Laicure/c7c90a0a76c0c03f8c6fa34c393803a3 to your computer and use it in GitHub Desktop.
Save Laicure/c7c90a0a76c0c03f8c6fa34c393803a3 to your computer and use it in GitHub Desktop.
Late Binding for Excel (Winforms)
Option Strict Off
Module UnModulatedX
#Region "Export To Excel"
Friend Sub Exporter(ByVal ExportName As String, dtFirst As DataTable, dtSecond As DataTable, firstSheetName As String, sencondSheetName As String)
'init
Dim excel As Object = CreateObject("Excel.Application")
Dim wBook As New Object
Dim wSheet As New Object
With excel
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
wBook = excel.Workbooks.Add
'second shit
wSheet = wBook.ActiveSheet
wSheet.Name = sencondSheetName
Dim dr As DataRow
Dim colIndex As Integer = 0
For Each dc As DataColumn In dtFirst.Columns
colIndex += 1
excel.Cells(1, colIndex) = dc.ColumnName
Next
Dim arrX(dtFirst.Rows.Count, dtFirst.Columns.Count) As Object
For r As Integer = 0 To dtFirst.Rows.Count - 1
dr = dtFirst.Rows(r)
For c As Integer = 0 To dtFirst.Columns.Count - 1
If IsDBNull(dr(c)) = False Then
If IsNumeric(dr(c)) = True Then
arrX(r, c) = dr(c)
Else
arrX(r, c) = Trim(dr(c).ToString)
End If
Else
arrX(r, c) = ""
End If
Next
Next
Dim c1 As Object = wSheet.Cells(2, 1)
Dim c2 As Object = wSheet.Cells(1 + dtFirst.Rows.Count, dtFirst.Columns.Count)
Dim Rr As Object = wSheet.Range(c1, c2)
Rr.Value2 = arrX
'first shit
If dtSecond.Rows.Count > 0 Then
Dim wSheet2 As Object
wSheet2 = wBook.Worksheets.add(wSheet, , , )
wSheet2.Name = firstSheetName
Dim drr As DataRow
Dim colIndexx As Integer = 0
For Each dc As DataColumn In dtSecond.Columns
colIndexx += 1
excel.Cells(1, colIndexx) = dc.ColumnName
Next
Dim arrXx(dtSecond.Rows.Count, dtSecond.Columns.Count) As Object
For r As Integer = 0 To dtSecond.Rows.Count - 1
drr = dtSecond.Rows(r)
For c As Integer = 0 To dtSecond.Columns.Count - 1
'formatting checks
If IsDBNull(drr(c)) = False Then
If IsNumeric(drr(c)) = True Then
arrXx(r, c) = drr(c)
Else
arrXx(r, c) = Trim(drr(c).ToString)
End If
Else
arrXx(r, c) = ""
End If
Next
Next
Dim c11 As Object = wSheet2.Cells(2, 1)
Dim c22 As Object = wSheet2.Cells(1 + dtSecond.Rows.Count, dtSecond.Columns.Count)
Dim Rrr As Object = wSheet2.Range(c11, c22)
Rrr.Value2 = arrXx
End If
With excel
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
wBook.SaveAs(ExportName & ".xlsb", 50)
wBook.Close(False, Nothing, Nothing)
excel.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(excel)
Runtime.InteropServices.Marshal.ReleaseComObject(wBook)
Runtime.InteropServices.Marshal.ReleaseComObject(wSheet)
GC.Collect()
End Sub
#End Region
#Region "Read Excel"
Friend Function ReadExcel(ByVal FilePath As String) As Data.DataTable
Dim excelData As New Data.DataTable
Dim excel As New Object
Dim wBook As New Object
Dim wSheet As New Object
excel = CreateObject("Excel.Application")
Try
wBook = excel.Workbooks.Open(FilePath)
wSheet = wBook.Worksheets("<SheetName>")
Catch ex As Exception
wBook.Close()
excel.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(excel)
Runtime.InteropServices.Marshal.ReleaseComObject(wBook)
Return Nothing
Exit Function
End Try
'get row count
Dim RowCount As Integer = wSheet.UsedRange.Rows.Count
Dim ColCount As Integer = wSheet.UsedRange.Columns.Count
'to Datatable
For colx As Integer = 1 To ColCount
excelData.Columns.Add(wSheet.Cells(1, colx).value)
Next
For rowx As Integer = 2 To RowCount Step 1
Dim rdr As Data.DataRow = excelData.NewRow
For colx As Integer = 1 To ColCount Step 1
rdr(colx - 1) = wSheet.Cells(rowx, colx).value
Next
excelData.Rows.Add(rdr)
Next
wBook.Close()
excel.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(excel)
Runtime.InteropServices.Marshal.ReleaseComObject(wBook)
Runtime.InteropServices.Marshal.ReleaseComObject(wSheet)
GC.Collect()
Return excelData
End Function
#End Region
End Module
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment