I have a vb.net project, want to export to excel (2010) in English from axmshflexgrid. But I have always an exception
Ancien format ou bibliothèque de type non valide
and an empty excel file with this code.
Private Sub cmd_export_excel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmd_export_excel.Click
On Error GoTo ErrorHandler
Dim iRow As Short
Dim iCol As Short
Dim objExcl As Microsoft.Office.Interop.Excel.Application
Dim objWk As Microsoft.Office.Interop.Excel.Workbook
Dim objSht As Microsoft.Office.Interop.Excel.Worksheet
Dim iHead As Short
Dim vHead As Object
objExcl = New Microsoft.Office.Interop.Excel.Application
objExcl.Visible = True
objExcl.UserControl = True
Dim oldCI As System.Globalization.CultureInfo = _
System.Threading.Thread.CurrentThread.CurrentCulture
System.Threading.Thread.CurrentThread.CurrentCulture = _
New System.Globalization.CultureInfo("en-US")
objWk = objExcl.Workbooks.Add
System.Threading.Thread.CurrentThread.CurrentCulture = oldCI
objSht = objWk.Sheets(1)
vHead = Split(g.FormatString, "|")
For iHead = 1 To UBound(vHead)
If Len(Trim(vHead(iHead))) > 0 Then objSht.Cells._Default(1, iHead) = vHead(iHead)
Next
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
For iRow = 0 To g.Rows - 1
For iCol = 0 To g.get_Cols() - 1
g.Row = iRow
g.Col = iCol
If g.Text <> "" Then
objSht.Range(NumCol2Lattre(iCol + 1) & "" & iRow + 2 & ":" & NumCol2Lattre(iCol + 1) & "" & iRow + 2 & "").Select()
objExcl.ActiveCell.Value = CStr(g.Text)
End If
Next iCol
Next iRow
objExcl.Application.Visible = True
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
objSht = Nothing
objWk = Nothing
objExcl = Nothing
Exit Sub
ErrorHandler:
objSht = Nothing
objWk = Nothing
objExcl = Nothing
MsgBox("Error In expotation task & " & Err.Description, MsgBoxStyle.Information)
Err.Clear()
End Sub
Do you have multiple versions installed?
Whats the version of you interop assemblies?
Compare the version with the created excel instance (objExcl.Version).
It looks like you have a version conflict.
You may have to re-install office2010 in this case(helps most of the time).
Related
I'm generating an xls file from a datatable on a button click. Right now the path to save the file is hardcoded in the function to generate the file:
Function CreateExcelFile(xlFile As String) As Boolean
Try
Dim xlRow As Integer = 2
Dim xlApp As New Microsoft.Office.Interop.Excel.Application
Dim xlWB = xlApp.Workbooks.Add
Dim xlWS = xlApp.Worksheets.Add
Dim intStr As Integer = 0
Dim NewFile As String = ""
Dim strCaption As String = "PSLF Driver Files Records"
xlFile = Replace(xlFile, "Return Files", "Reports")
xlFile = Replace(xlFile, "txt", "xlsx")
xlFile = Replace(xlFile, "_", " ")
intStr = InStr(xlFile, "Reports")
xlApp.IgnoreRemoteRequests = True
xlWS = xlWB.Worksheets(xlApp.ActiveSheet.Name)
xlApp.DisplayAlerts = False
xlApp.Sheets.Add()
Dim xlTopRow As Integer = 2 'First Row to enter data
xlApp.Sheets.Add()
xlApp.Sheets(1).Name = strCaption
xlApp.Sheets(1).Select()
'Store datatable in 2-dimensional array
Dim arrExcel(frm_Records.BindingSource1.DataSource.Rows.Count, frm_Records.BindingSource1.DataSource.Columns.Count - 1) As String
'Write header row to array
arrExcel(0, 0) = "SSN"
arrExcel(0, 1) = "CREATE_DATE"
arrExcel(0, 2) = "SERVICER_CODE"
arrExcel(0, 3) = "STATUS"
arrExcel(0, 4) = "DRIVER_FILE_OUT"
arrExcel(0, 5) = "LAST_UPDATE_USER"
arrExcel(0, 6) = "LAST_UPDATE_DATE"
arrExcel(0, 7) = "CREATE_USER"
'Copy rows from datatable to array
xlRow = 1
For Each dr As DataRow In frm_Records.BindingSource1.DataSource.Rows
arrExcel(xlRow, 0) = dr("SSN")
arrExcel(xlRow, 1) = dr("CREATE_DATE")
arrExcel(xlRow, 2) = dr("SERVICER_CODE")
arrExcel(xlRow, 3) = dr("STATUS")
If IsDBNull(dr("DRIVER_FILE_OUT")) Then
arrExcel(xlRow, 4) = ""
Else
arrExcel(xlRow, 4) = dr("DRIVER_FILE_OUT")
End If
arrExcel(xlRow, 5) = dr("LAST_UPDATE_USER")
arrExcel(xlRow, 6) = dr("LAST_UPDATE_DATE")
arrExcel(xlRow, 7) = dr("CREATE_USER")
xlRow += 1
Next
'Set up range
Dim c1 As Microsoft.Office.Interop.Excel.Range = xlApp.Range("A1") 'Top left of data
Dim c2 As Microsoft.Office.Interop.Excel.Range = xlApp.Range("T" & frm_Records.BindingSource1.DataSource.Rows.Count - 1 + xlTopRow) 'Bottom right of data
Dim xlRange As Microsoft.Office.Interop.Excel.Range = xlApp.Range(c1, c2)
xlRange.Value = arrExcel 'Write array to range in Excel
xlWB.ActiveSheet.Range("A:T").Columns.Autofit()
xlWB.ActiveSheet.Range("A1:T1").Interior.Color = RGB(255, 255, 153)
xlWB.ActiveSheet.Range("A1:T1").Font.Bold = True
With xlApp.ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
xlApp.ActiveWindow.FreezePanes = True
Dim strSheet As String
For Each Sht In xlWB.Worksheets
If Sht.name Like "*Sheet*" Then
strSheet = Sht.name
xlApp.Sheets(strSheet).delete()
End If
Next
xlApp.IgnoreRemoteRequests = False
xlWB.SaveAs(xlFile)
xlWB.Close()
Dim xlHWND As Integer = xlApp.Hwnd
'this will have the process ID after call to GetWindowThreadProcessId
Dim ProcIdXL As Integer = 0
'get the process ID
GetWindowThreadProcessId(xlHWND, ProcIdXL)
'get the process
Dim xproc As Process = Process.GetProcessById(ProcIdXL)
xlApp.Quit()
'Release
System.Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
'set to nothing
xlApp = Nothing
'kill it with glee
If Not xproc.HasExited Then
xproc.Kill()
End If
Catch ex As Exception
WP.WAPC_RUNSCRIPT_ERROR_FILE(WP.argScriptName, "Error Writing to Excel Report: " & ex.Message)
Return False
End Try
Return True
End Function
<DllImport("user32.dll", SetLastError:=True)> _
Private Function GetWindowThreadProcessId(ByVal hwnd As IntPtr, _
ByRef lpdwProcessId As Integer) As Integer
End Function
#End Region
What I want to do is upon completion of the creation of the Excel file, I want to give the user the option of where to save the newly created file. I'm new at
Winforms and am not sure how to do this.
What is the best way to enable the user to choose where to saved the file?
Update:
Working code after #Claudius' answer.
Private Sub btnRecExport_Click(sender As Object, e As EventArgs) Handles
btnRecExport.Click
Dim file As String = "I:\PSLFRecords.xlsx"
CreateExcelFile(file)
Dim sfdRecords As New SaveFileDialog()
sfdRecords.Filter = "Excel File|*.xls"
sfdRecords.Title = "Save PSLF Driver Records"
sfdRecords.ShowDialog()
If sfdRecords.FileName <> "" Then
xlWB.SaveAs(sfdRecords.FileName)
fs.Close()
End If
End Sub
From MSDN edited to your needs:
Private Sub Button2_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles Button2.Click
' Displays a SaveFileDialog so the user can save the Image
' assigned to Button2.
Dim saveFileDialog1 As New SaveFileDialog()
saveFileDialog1.Filter = "Excel File|*.xls
saveFileDialog1.Title = "Save an Excel File"
saveFileDialog1.ShowDialog()
' If the file name is not an empty string open it for saving.
If saveFileDialog1.FileName <> "" Then
xlWB.SaveAs(saveFileDialog1.FileName)
fs.Close()
End If
End Sub
All you'd actually need is just a new instance of the FolderBrowserDialog Class, that will return to you the path the user selected. All the information you need is already present in the documentation.
I have a folder that has emails with attachments and without attachments. i have the code for extracting the attachments names but if an email doesn't have attachments the code will stop. Any help is welcomed, thank you.
by jimmypena
Private Sub CommandButton2_Click()
Dim a As Attachments
Dim myitem As Folder
Dim myitem1 As MailItem
Dim j As Long
Dim i As Integer
Set myitem = Session.GetDefaultFolder(olFolderDrafts)
For i = 1 To myitem.Items.Count
If myitem.Items(i) = test1 Then
Set myitem1 = myitem.Items(i)
Set a = myitem1.Attachments
MsgBox a.Count
' added this code
For j = 1 To myitem1.Attachments.Count
MsgBox myitem1.Attachments.Item(i).DisplayName ' or .Filename
Next j
End If
Next i
End Sub
My code:
Sub EXPORT()
Const FOLDER_PATH = "\\Mailbox\Inbox\emails from them"
Dim olkMsg As Object, _
olkFld As Object, _
excApp As Object, _
excWkb As Object, _
excWks As Object, _
intRow As Integer, _
intCnt As Integer, _
strFileName As String, _
arrCells As Variant
strFileName = "C:\EXPORT"
If strFileName <> "" Then
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.ActiveSheet
excApp.DisplayAlerts = False
With excWks
.Cells(1, 1) = "ATTACH NAMES"
.Cells(1, 2) = "SENDER"
.Cells(1, 3) = "NR SUBJECT"
.Cells(1, 4) = "CATEGORIES"
End With
intRow = 2
Set olkFld = OpenOutlookFolder(FOLDER_PATH)
For Each olkMsg In olkFld.Items
If olkMsg.Class = olMail Then
arrCells = Split(GetCells(olkMsg.HTMLBody), Chr(255))
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As match
Set Reg1 = New RegExp
With Reg1
.Pattern = "\s*[-]+\s*(\w*)\s*(\w*)"
.Global = True
End With
Set M1 = Reg1.Execute(olkMsg.Subject)
For Each M In M1
excWks.Cells(intRow, 3) = M
Next
Dim a As Attachments
Set a = olkMsg.Attachments
If Not a Is Nothing Then
excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename
'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress
End If
excWks.Cells(intRow, 2) = olkMsg.sender.GetExchangeUser.PrimarySmtpAddress
excWks.Cells(intRow, 4) = olkMsg.Categories
intRow = intRow + 1
intCnt = intCnt + 1
End If
Next
Set olkMsg = Nothing
excWkb.SaveAs strFileName, 52
excWkb.Close
End If
Set olkFld = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
MsgBox "Ta dam! "
End Sub
edited
Set a = myitem1.Attachments
MsgBox a.Count
For j = 1 To myitem1.Attachments.Count
MsgBox myitem1.Attachments.Item(j).DisplayName ' or .Filename
Next j
as about your edited question, replace the following snippet
Dim a As Attachments
Set a = olkMsg.Attachments
If Not a Is Nothing Then
excWks.Cells(intRow, 1) = olkMsg.Attachment.Filename
'excWks.Cells(intRow, 2) = olkMsg.SenderEmailAddress
End If
with:
Dim a As Attachment
For Each a In olkMsg.Attachments
excWks.Cells(intRow, 1) = a.FileName
'excWks.Cells(intRow, 2) = a.SenderEmailAddress
Next a
which you must treat appropriately as for the intRow index.
if you are interested in only the first attachment then you could substitute the entire last code with this:
excWks.Cells(intRow, 1) = olkMsg.Attachments.Item(1).FileName
while if you are interested in all attachments then you'll have to rethink about your sheet report structure
i currently have the problem that everytime im trying to open a word document via vba/excel im getting an Application/Object Error. My Idea is that im trying to compare data from two tables and deleting the bad results. After that i want to insert the whole table to the existing word document what im selecting from the selection/opening window.
My Code
Private Sub CommandButton1_Click()
Dim varDatei As Variant
Dim wordDatei As Variant
Dim objExcel As New Excel.Application
Dim objSheet As Object
Dim wordDoc As Object
Dim extBereich As Variant
Dim intBereich As Variant
Dim appWord As Object
Set intBereich = ThisWorkbook.Sheets(1).Range("A4:A11")
Dim loopStr As Variant
Dim loopStr2 As Variant
Dim found() As Variant
Dim loopInt As Integer
Dim endStr As Variant
Dim extBereich2 As Variant
loopInt = 1
varDatei = Application.GetOpenFilename("Excel-Dateien (*.xlsx), *.xlsx")
If varDatei <> False Then
objExcel.Workbooks.Open varDatei
Set objSheets = objExcel.Sheets(1)
objSheets.Activate
LetzteZeile = objSheets.Cells(objSheets.Rows.Count, 3).End(xlUp).Row
Set extBereich = objSheets.Range("B3:B" & LetzteZeile)
ReDim found(1 To LetzteZeile)
For Each loopStr In extBereich
objSheets.Range("F" & loopStr.Row) = "Good"
objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 4
For Each loopStr2 In intBereich
If (StrComp(loopStr, loopStr2, vbBinaryCompare) = 0) = True Then
found(loopInt) = objSheets.Range("A" & loopStr.Row)
loopInt = loopInt + 1
objSheets.Cells(loopStr.Row, 6) = "Bad"
objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 3
Exit For
End If
Next loopStr2
Next loopStr
loopStr = ""
If (loopInt <> 1) Then
endStr = "This is bad:" & vbLf
For Each loopStr In found
If (Trim(loopStr & vbNullString) <> vbNullString) Then
endStr = endStr & loopStr & vbLf
End If
Next loopStr
MsgBox (endStr)
Else
MsgBox ("Everythings good")
End If
Set appWord = CreateObject("Word.Application")
appWord.DisplayAlerts = False
Debug.Print ("123")
Set wordDoc = appWord.Documents.Open(Application.GetOpenFilename("Word-Dateien (*.doc;*.docx;),*.doc;*.docx"))
wordDoc.Activate
Debug.Print ("456")
loopStr = ""
For Each loopStr In extBereich
If (objSheets.Cells(loopStr.Row, 6).Interior.ColorIndex = 3) Then
objSheets.Range("A" & loopStr.Row & ":" & "E" & loopStr.Row).Delete
End If
Next loopStr
objSheets.Range(Columns(2), Columns(4)).Delete
objSheets.Range("A3:B" & LetzteZeile).Copy
appWord.Documents(1).Range.Paste
With appWord.Documents(1).Tables(1)
.Columns.AutoFit
End With
appWord.PrintOut
objExcel.Quit
appWord.Quit
Set appWord = Nothing
Set objExcel = Nothing
Debug.Print loopInt
Else
MsgBox "Error"
End If
End Sub
Maybe someone of you knew whats the problem?
Error Code is 1004 - Application- or object Error
With best regards and thanks for answering
Your problem is with the line:
objSheets.Range(Columns(2), Columns(4)).Delete
You need to specify where the columns are, e.g.
objSheets.Range(objSheets.Columns(2), objSheets.Columns(4)).Delete
i'm using visual studio 2012 and microsoft SQL server 2012 to export datagridview to excel using this coding:
Public Class Export
Private Sub Export_Load(sender As Object, e As EventArgs) Handles MyBase.Load
DataGridView1.AllowUserToAddRows = False
ClassKoneksi.namadatabase = "KPIRWAN"
Dim dssiswa As New DataSet
Dim sql As String
sql = "select*from Siswa order by NIS ASC"
dssiswa = ClassSiswa.displayData(ClassSiswa.opencon, sql, "DataSiswa")
DataGridView1.DataSource = dssiswa
DataGridView1.DataMember = "DataSiswa"
DataGridView1.ReadOnly = True
ClassSiswa.closecon()
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
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
ExportExcel()
End Sub
Private Sub ExportExcel()
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim oValue As Object = System.Reflection.Missing.Value
Dim sPath As String = String.Empty
Dim dlgSave As New SaveFileDialog
dlgSave.DefaultExt = "xls"
dlgSave.Filter = "Microsoft Excel|*.xls"
dlgSave.InitialDirectory = Application.StartupPath
If dlgSave.ShowDialog = Windows.Forms.DialogResult.OK Then
Try
xlApp = New Microsoft.Office.Interop.Excel.Application
xlBook = xlApp.Workbooks.Add(oValue)
xlSheet = xlBook.Worksheets("sheet1")
Dim xlRow As Long = 2
Dim xlCol As Short = 1
For k As Integer = 0 To DataGridView1.ColumnCount - 1
xlSheet.Cells(1, xlCol) = DataGridView1(k, 0).Value
xlCol += 1
Next
For k As Integer = 0 To DataGridView1.ColumnCount - 1
xlSheet.Cells(2, xlCol) = DataGridView1(k, 0).Value
xlCol += 1
Next
For i As Integer = 0 To DataGridView1.RowCount - 1
xlCol = 1
For k As Integer = 0 To DataGridView1.ColumnCount - 1
xlSheet.Cells(xlRow, xlCol) = DataGridView1(k, i).Value
xlCol += 1
Next
xlRow += 1
Next
xlSheet.Columns.AutoFit()
Dim sFileName As String = Replace(dlgSave.FileName, ".xlsx", "xlx")
xlSheet.SaveAs(sFileName)
xlBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlBook)
releaseObject(xlSheet)
MsgBox("Data successfully exported.", MsgBoxStyle.Information, "PRMS/SOB Date Tagging")
Catch
MsgBox(ErrorToString)
Finally
End Try
End If
End Sub
End Class
it work perfectly fine except when i exported the datagridview to excel the column header text in the datagridview is not exported to excel sheet only the gridview.
how do i make the coding to get the column header text to excel sheet?
I think you'll have to get the HeaderText from each column like this:
xlSheet.Cells(x,y).Value = DataGridView1.Columns(k).HeaderText
You would put this in your "k" loop. And then write it wherever you want in the file. x and y have to be the location where you write the header (maybe determined by k)
EDIT: writing the headers in first row of excel
For k As Integer = 0 To DataGridView1.ColumnCount - 1
xlSheet.Cells(1,k+1).Value = DataGridView1.Columns(k).HeaderText
Next
I have a problem when I export a flexgrid to excel from vb.net vs2008 to office 2010 english version an excel file is opened but it is empty. However, when I use office french version it is opened [correctly]
My code is:
On Error GoTo ErrorHandler
Dim iRow As Short
Dim iCol As Short
Dim objExcl As Excel.Application
Dim objWk As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim iHead As Short
Dim vHead As Object
objExcl = New Excel.Application
objExcl.Visible = True
objExcl.UserControl = True
Dim oldCI As System.Globalization.CultureInfo = _
System.Threading.Thread.CurrentThread.CurrentCulture
System.Threading.Thread.CurrentThread.CurrentCulture = _
New System.Globalization.CultureInfo("en-US")
objWk = objExcl.Workbooks.Add
System.Threading.Thread.CurrentThread.CurrentCulture = oldCI
objSht = objWk.Sheets(1)
vHead = Split(g.FormatString, "|")
'populate heading in the sheet
'take the column heading from flex grid and put it in the sheet
For iHead = 1 To UBound(vHead)
If Len(Trim(vHead(iHead))) > 0 Then objSht.Cells._Default(1, iHead) = vHead(iHead)
Next
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor
For iRow = 0 To g.Rows - 1
For iCol = 0 To g.get_Cols() - 1
g.Row = iRow
g.Col = iCol
'
'If g.Text <> "" Then objSht.Cells._Default(iRow + 2, iCol + 1) = g.Text
If g.Text <> "" Then
objSht.Range(NumCol2Lattre(iCol + 1) & "" & iRow + 2 & ":" & NumCol2Lattre(iCol + 1) & "" & iRow + 2 & "").Select()
objExcl.ActiveCell.Value = g.Text
End If
Next iCol
Next iRow
objExcl.Application.Visible = True
System.Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.Default
objSht = Nothing
objWk = Nothingl may not be destroyed until it is garbage collected. Click
objExcl = Nothing
Exit Sub
ErrorHandler:
objSht = Nothing
objWk = Nothing
objExcl = Nothing
MsgBox("Error In expotation task & " & Err.Description, MsgBoxStyle.Information)
Err.Clear()
Check out this website Exporting MSFlexGrid to Excel
I suspect your problem is with vHead = Split(g.FormatString, "|") Use the debugger to find out what is the value of g.FormatString. Is it causing an error? Step through the code one line at a time and see what happens.
On Error GoTo ErrorHandler
Imports System.Data
Imports System.IO
Imports System.Web.UI
Partial Class ExportGridviewDatainVB
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
If Not IsPostBack Then
BindGridview()
End If
End Sub
Protected Sub BindGridview()
Dim dt As New DataTable()
dt.Columns.Add("UserId", GetType(Int32))
dt.Columns.Add("UserName", GetType(String))
dt.Columns.Add("Education", GetType(String))
dt.Columns.Add("Location", GetType(String))
dt.Rows.Add(1, "SureshDasari", "B.Tech", "Chennai")
dt.Rows.Add(2, "MadhavSai", "MBA", "Nagpur")
dt.Rows.Add(3, "MaheshDasari", "B.Tech", "Nuzividu")
dt.Rows.Add(4, "Rohini", "MSC", "Chennai")
dt.Rows.Add(5, "Mahendra", "CA", "Guntur")
dt.Rows.Add(6, "Honey", "B.Tech", "Nagpur")
gvDetails.DataSource = dt
gvDetails.DataBind()
End Sub
Public Overrides Sub VerifyRenderingInServerForm(ByVal control As Control)
' Verifies that the control is rendered
End Sub
Protected Sub btnExport_Click(ByVal sender As Object, ByVal e As EventArgs)
Response.ClearContent()
Response.Buffer = True
Response.AddHeader("content-disposition", String.Format("attachment; filename={0}", "Customers.xls"))
Response.ContentType = "application/ms-excel"
Dim sw As New StringWriter()
Dim htw As New HtmlTextWriter(sw)
gvDetails.AllowPaging = False
BindGridview()
'Change the Header Row back to white color
gvDetails.HeaderRow.Style.Add("background-color", "#FFFFFF")
'Applying stlye to gridview header cells
For i As Integer = 0 To gvDetails.HeaderRow.Cells.Count - 1
gvDetails.HeaderRow.Cells(i).Style.Add("background-color", "#df5015")
Next
gvDetails.RenderControl(htw)
Response.Write(sw.ToString())
Response.[End]()
End Sub
End Class