求一个Vb.net 2005导出Excel 的类

_
Public Class ExportExcel
Private s As New StringBuilder()


'/ <summary>
'/ Export Excel use GridView data
'/ </summary>
'/ <param name="Typename"></param>
'/ <param name="TempGrid"></param>
Public Shared Sub GenerateByGridView(Typename As String,TempGrid As GridView)
HttpContext.Current.Response.Clear()
'HttpContext.Current.Response.Buffer = true;
HttpContext.Current.Response.Charset = "utf-8"
Dim Filename As String = Typename + ".xls"
HttpContext.Current.Response.AppendHeader("Content-Disposition","online;filename=" + Filename)
HttpContext.Current.Response.ContentEncoding = System.Text.Encoding.GetEncoding("utf-8")
HttpContext.Current.Response.ContentType = "application/ms-excel"
'this.EnableViewState = false;
Dim oStringWriter As New System.IO.StringWriter()
Dim oHtmlTextWriter As New System.Web.UI.HtmlTextWriter(oStringWriter)
TempGrid.RenderControl(oHtmlTextWriter)
HttpContext.Current.Response.Write(oStringWriter.ToString())
HttpContext.Current.Response.End()
End Sub 'GenerateByGridView


'/ <summary>
'/ Export Excel use Html string data
'/ </summary>
'/ <param name="Typename"></param>
'/ <param name="TempHtml"></param>
Public Shared Sub GenerateByHtmlString(Typename As String,TempHtml As String)
HttpContext.Current.Response.Clear()
HttpContext.Current.Response.Buffer = True
HttpContext.Current.Response.Charset = "utf-8"
Dim Filename As String = Typename + ".xls"
HttpContext.Current.Response.AppendHeader("Content-Disposition","online;filename=" + Filename)
HttpContext.Current.Response.ContentEncoding = System.Text.Encoding.GetEncoding("utf-8")
HttpContext.Current.Response.ContentType = "application/ms-excel"
'this.EnableViewState = false;
HttpContext.Current.Response.Write(TempHtml)
HttpContext.Current.Response.End()
End Sub 'GenerateByHtmlString


'/ <summary>
'/
'/ </summary>
'/ <param name="Typename"></param>
'/ <param name="TempHtml"></param>
Public Sub CreateExcelWithMode(TableRows As Integer,TableColumns As Integer,FileName As String)
Dim TableString As String = ""
TableString += TableStart(TableRows,TableColumns)
TableString += s.ToString()
TableString += TableEnd()
Dim ModePath As String = HttpContext.Current.Server.MapPath("~/Refdll/ExcelMode.xml")
Dim xmlDoc As New XmlDocument()
xmlDoc.Load(ModePath)
Dim ExcelXmlStr As String = xmlDoc.InnerXml
ExcelXmlStr = ExcelXmlStr.Insert(ExcelXmlStr.IndexOf("</Worksheet>"),TableString)
GenerateByHtmlString(FileName,ExcelXmlStr)
End Sub 'CreateExcelWithMode


'
'ToDo: Error processing original source shown below
'
'
'-----------^--- Pre-processor directives not translated
Private Function TableStart(rows As Integer,columns As Integer) As String
'
'ToDo: Error processing original source shown below
'
'
'--^--- Unexpected pre-processor directive
Dim TableString As String = ""
TableString += "<Table ss:ExpandedRowCount=""" + rows + """ ss:ExpandedColumnCount=""" + columns + """ x:FullColumns=""1"ControlChars.Lf
TableString += "x:FullRows=""1"" ss:DefaultColumnWidth=""70"" ss:DefaultRowHeight=""14.25"">" + ControlChars.Lf
Return TableString
End Function 'TableStart

Private Function TableEnd() As String
Dim TableString As String = ""
TableString += "</Table>" + ControlChars.Lf
Return TableString
End Function 'TableEnd

Public Sub RowStart()
s.Append("<Row ss:AutoFitHeight=""0"">" + ControlChars.Lf)
End Sub 'RowStart

Public Sub RowEnd()
s.Append("</Row>" + ControlChars.Lf)
End Sub 'RowEnd

Public Sub CellWithoutFormula(DataType As String,Data As String)
s.Append(("<Cell><Data ss:Type=""" + DataType + """>" + Data + "</Data></Cell>" + ControlChars.Lf))
End Sub 'CellWithoutFormula

Public Sub CellWithFormula(DataType As String,Formula As String)
s.Append(("<Cell ss:Formula=""=" + Formula + """><Data ss:Type=""" + DataType + """></Data></Cell>" + ControlChars.Lf))
End Sub 'CellWithFormula
End Class 'ExportExcel '
'ToDo: Error processing original source shown below
'
'
'-----------^--- Pre-processor directives not translated
'
'ToDo: Error processing original source shown below
'
'
'--^--- Unexpected pre-processor directive

VB.NET code

            
            

             
              
             
             '
             
             把DataTable里的内容导出到EXCEL,执行代码就行,什么都不用改,什么都不用设置 
             
              
             
             Private
             
              
             
             Sub
             
              toExcel(
             
             ByVal
             
              tb 
             
             As
             
              DataTable) 
             
             Dim
             
              dgrid 
             
             As
             
              System.Web.UI.WebControls.DataGrid 
             
             =
             
              
             
             Nothing
             
              
             
             Dim
             
              context 
             
             As
             
              System.Web.HttpContext 
             
             =
             
              System.Web.HttpContext.Current 
             
             Dim
             
              strOur 
             
             As
             
              System.IO.StringWriter 
             
             =
             
              
             
             Nothing
             
              
             
             Dim
             
              htmlWriter 
             
             As
             
              System.Web.UI.HtmlTextWriter 
             
             =
             
              
             
             Nothing
             
              
             
             If
             
              
             
             Not
             
              
             
             IsNothing
             
             (tb) 
             
             Then
             
              context.Response.ContentType 
             
             =
             
              
             
             "
             
             application/vnd.ms-excel 
             
             "
             
              context.Response.ContentEncoding 
             
             =
             
              System.Text.Encoding.UTF8 context.Response.Charset 
             
             =
             
              
             
             "
             
              
             
             "
             
              strOur 
             
             =
             
              
             
             New
             
              IO.StringWriter htmlWriter 
             
             =
             
              
             
             New
             
              System.Web.UI.HtmlTextWriter(strOur) dgrid 
             
             =
             
              
             
             New
             
              DataGrid dgrid.DataSource 
             
             =
             
              tb.DefaultView dgrid.AllowPaging 
             
             =
             
              
             
             False
             
              dgrid.DataBind() dgrid.RenderControl(htmlWriter) context.Response.Write(strOur.ToString) context.Response.End() 
             
             End
             
              
             
             If
             
              
             
             End
             
              
             
             Sub
             
              
            
            

[code=VB.NET][/code]
Imports Microsoft.Office.Interop

Try
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
xlBook = xlApp.Workbooks.Add(True)
Dim rowIndex As Integer = 1
Dim colIndex As Integer = 0

For colIndex = 0 To DataGridView1.Columns.Count - 1
xlApp.Cells(1,colIndex + 1) = DataGridView1.Columns(colIndex).HeaderCell.Value
Next

For rowIndex = 1 To DataGridView1.Rows.Count - 1
For colIndex = 0 To DataGridView1.Columns.Count - 1
xlApp.Cells(rowIndex + 1,colIndex + 1) = DataGridView1.Rows(rowIndex - 1).Cells(colIndex).Value.ToString
Next
Next
xlApp.Visible = True

xlBook = Nothing
xlApp = Nothing
Catch ex As Exception
MsgBox("导出excle失败！" & ex.ToString().Trim(),MsgBoxStyle.Exclamation,"系统提示： ")

End Try

原创：魏滔序
博客：http://blog.csdn.net/Modest/archive/2007/07/30/1716649.aspx

'引入Excel的COM组件

Imports System
Imports System.Data
Imports System.Configuration
Imports System.Web
Imports System.Web.Security
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Core


Namespace ExcelEdit
''' <summary>
''' ExcelEdit 的摘要说明
''' </summary>
Public Class ExcelEdit
Public mFilename As String
Public app As Excel.Application
Public wbs As Excel.Workbooks
Public wb As Excel.Workbook
Public wss As Excel.Worksheets
Public ws As Excel.Worksheet
'
' TODO: 在此处添加构造函数逻辑
'
Public Sub New()
End Sub
Public Sub Create()
'创建一个Excel对象
app = New Excel.Application()
wbs = app.Workbooks
wb = wbs.Add(True)
End Sub
Public Sub Open(ByVal FileName As String)
'打开一个Excel文件
app = New Excel.Application()
wbs = app.Workbooks
wb = wbs.Add(FileName)
'wb = wbs.Open(FileName,true,5,"",Excel.XlPlatform.xlWindows,"t",false,Type.Missing,Type.Missing);
'wb = wbs.Open(FileName,Type.Missing);
mFilename = FileName
End Sub
Public Function GetSheet(ByVal SheetName As String) As Excel.Worksheet
'获取一个工作表
Dim s As Excel.Worksheet = DirectCast(wb.Worksheets(SheetName),Excel.Worksheet)
Return s
End Function
Public Function AddSheet(ByVal SheetName As String) As Excel.Worksheet
'添加一个工作表
Dim s As Excel.Worksheet = DirectCast(wb.Worksheets.Add(Type.Missing,Type.Missing),Excel.Worksheet)
s.Name = SheetName
Return s
End Function

Public Sub DelSheet(ByVal SheetName As String)
'删除一个工作表
DirectCast(wb.Worksheets(SheetName),Excel.Worksheet).Delete()
End Sub
Public Function ReNameSheet(ByVal OldSheetName As String,ByVal NewSheetName As String) As Excel.Worksheet
'重命名一个工作表一
Dim s As Excel.Worksheet = DirectCast(wb.Worksheets(OldSheetName),Excel.Worksheet)
s.Name = NewSheetName
Return s
End Function

Public Function ReNameSheet(ByVal Sheet As Excel.Worksheet,ByVal NewSheetName As String) As Excel.Worksheet
'重命名一个工作表二

Sheet.Name = NewSheetName

Return Sheet
End Function

Public Sub SetCellValue(ByVal ws As Excel.Worksheet,ByVal x As Integer,ByVal y As Integer,ByVal value As Object)
'ws：要设值的工作表 X行Y列 value 值
ws.Cells(x,y) = value
End Sub
Public Sub SetCellValue(ByVal ws As String,ByVal value As Object)
'ws：要设值的工作表的名称 X行Y列 value 值

GetSheet(ws).Cells(x,y) = value
End Sub

Public Sub SetCellProperty(ByVal ws As Excel.Worksheet,ByVal Startx As Integer,ByVal Starty As Integer,ByVal Endx As Integer,ByVal Endy As Integer,ByVal size As Integer,_
ByVal name As String,ByVal color As Excel.Constants,ByVal HorizontalAlignment As Excel.Constants)
'设置一个单元格的属性 字体， 大小，颜色 ，对齐方式
name = "宋体"
size = 12
color = Excel.Constants.xlAutomatic
HorizontalAlignment = Excel.Constants.xlRight
ws.get_Range(ws.Cells(Startx,Starty),ws.Cells(Endx,Endy)).Font.Name = name
ws.get_Range(ws.Cells(Startx,Endy)).Font.Size = size
ws.get_Range(ws.Cells(Startx,Endy)).Font.Color = color
ws.get_Range(ws.Cells(Startx,Endy)).HorizontalAlignment = HorizontalAlignment
End Sub

Public Sub SetCellProperty(ByVal wsn As String,ByVal HorizontalAlignment As Excel.Constants)
'name = "宋体";
'size = 12;
'color = Excel.Constants.xlAutomatic;
'HorizontalAlignment = Excel.Constants.xlRight;

Dim ws As Excel.Worksheet = GetSheet(wsn)
ws.get_Range(ws.Cells(Startx,Endy)).Font.Color = color

ws.get_Range(ws.Cells(Startx,Endy)).HorizontalAlignment = HorizontalAlignment
End Sub

接上：

Public Sub SetCellProperty(ByVal wsn As String,Endy)).HorizontalAlignment = HorizontalAlignment
End Sub


Public Sub UniteCells(ByVal ws As Excel.Worksheet,ByVal x1 As Integer,ByVal y1 As Integer,ByVal x2 As Integer,ByVal y2 As Integer)
'合并单元格
ws.get_Range(ws.Cells(x1,y1),ws.Cells(x2,y2)).Merge(Type.Missing)
End Sub

Public Sub UniteCells(ByVal ws As String,ByVal y2 As Integer)
'合并单元格
GetSheet(ws).get_Range(GetSheet(ws).Cells(x1,GetSheet(ws).Cells(x2,y2)).Merge(Type.Missing)

End Sub


Public Sub InsertTable(ByVal dt As System.Data.DataTable,ByVal ws As String,ByVal startX As Integer,ByVal startY As Integer)
'将内存中数据表格插入到Excel指定工作表的指定位置 为在使用模板时控制格式时使用一
For i As Integer = 0 To dt.Rows.Count - 1

For j As Integer = 0 To dt.Columns.Count - 1

GetSheet(ws).Cells(startX + i,j + startY) = dt.Rows(i)(j).ToString()

Next
Next

End Sub
Public Sub InsertTable(ByVal dt As System.Data.DataTable,ByVal ws As Excel.Worksheet,ByVal startY As Integer)
'将内存中数据表格插入到Excel指定工作表的指定位置二
For i As Integer = 0 To dt.Rows.Count - 1

For j As Integer = 0 To dt.Columns.Count - 1


ws.Cells(startX + i,j + startY) = dt.Rows(i)(j)

Next
Next

End Sub


Public Sub AddTable(ByVal dt As System.Data.DataTable,ByVal startY As Integer)
'将内存中数据表格添加到Excel指定工作表的指定位置一
For i As Integer = 0 To dt.Rows.Count - 1

For j As Integer = 0 To dt.Columns.Count - 1


GetSheet(ws).Cells(i + startX,j + startY) = dt.Rows(i)(j)

Next
Next

End Sub
Public Sub AddTable(ByVal dt As System.Data.DataTable,ByVal startY As Integer)
'将内存中数据表格添加到Excel指定工作表的指定位置二
For i As Integer = 0 To dt.Rows.Count - 1


For j As Integer = 0 To dt.Columns.Count - 1


ws.Cells(i + startX,j + startY) = dt.Rows(i)(j)
Next
Next

End Sub
Public Sub InsertPictures(ByVal Filename As String,ByVal ws As String)
'插入图片操作一
GetSheet(ws).Shapes.AddPicture(Filename,MsoTriState.msoFalse,MsoTriState.msoTrue,10,150,_
150)
'后面的数字表示位置
End Sub

'public void InsertPictures(string Filename,string ws,int Height,int Width)//插入图片操作二
'{
' GetSheet(ws).Shapes.AddPicture(Filename,150);
' GetSheet(ws).Shapes.get_Range(Type.Missing).Height = Height;
' GetSheet(ws).Shapes.get_Range(Type.Missing).Width = Width;
'}
'public void InsertPictures(string Filename,int left,int top,int Width)//插入图片操作三
'{

' GetSheet(ws).Shapes.AddPicture(Filename,150);
' GetSheet(ws).Shapes.get_Range(Type.Missing).IncrementLeft(left);
' GetSheet(ws).Shapes.get_Range(Type.Missing).IncrementTop(top);
' GetSheet(ws).Shapes.get_Range(Type.Missing).Height = Height;
' GetSheet(ws).Shapes.get_Range(Type.Missing).Width = Width;
'}
Public Sub InsertActiveChart(ByVal ChartType As Excel.XlChartType,ByVal DataSourcesX1 As Integer,ByVal DataSourcesY1 As Integer,ByVal DataSourcesX2 As Integer,ByVal DataSourcesY2 As Integer,_
ByVal ChartDataType As Excel.XlRowCol)
'插入图表操作
ChartDataType = Excel.XlRowCol.xlColumns
wb.Charts.Add(Type.Missing,Type.Missing)
wb.ActiveChart.ChartType = ChartType
wb.ActiveChart.SetSourceData(GetSheet(ws).get_Range(GetSheet(ws).Cells(DataSourcesX1,DataSourcesY1),GetSheet(ws).Cells(DataSourcesX2,DataSourcesY2)),ChartDataType)
wb.ActiveChart.Location(Excel.XlChartLocation.xlLocationAsObject,ws)
End Sub
Public Function Save() As Boolean
'保存文档
If mFilename = "" Then
Return False
Else
Try
wb.Save()
Return True
Catch ex As Exception

Return False
End Try
End If
End Function
Public Function SaveAs(ByVal FileName As Object) As Boolean
'文档另存为
Try
wb.SaveAs(FileName,_
Excel.XlSaveAsAccessMode.xlExclusive,Type.Missing)

Return True
Catch ex As Exception


Return False
End Try
End Function
Public Sub Close()
'关闭一个Excel对象，销毁对象
'wb.Save();
wb.Close(Type.Missing,Type.Missing)
wbs.Close()
app.Quit()
wb = Nothing
wbs = Nothing
app = Nothing
GC.Collect()
End Sub
End Class
End Namespace

谢谢各位,小弟自己也写了一个...
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Public Class Cls_Excel
Private xlApp As Object
Private xlBook As Object
Private xlSheet As Object
Public Sub New()
xlApp = CreateObject("Excel.Application")
End Sub
Public Function AddBook(ByVal hStr_TemplateFile As String) As Boolean

Dim Bln_Add As Boolean = False

Try
If System.IO.File.Exists(hStr_TemplateFile) = False Then

Bln_Add = False

ElseIf Microsoft.VisualBasic.StrConv(Right(hStr_TemplateFile,3),VbStrConv.Lowercase) <> "xls" Then

Bln_Add = False
Else
xlBook = xlApp.Workbooks.Open(hStr_TemplateFile)
xlSheet = xlBook.Worksheets(1)
Bln_Add = True
End If
Catch ex As Exception
Finally
End Try
Return Bln_Add

End Function

Public Property Visible() As Boolean
Get
Return xlApp.Visible
End Get
Set(ByVal value As Boolean)
xlApp.Visible = value
End Set
End Property
'获取单一单元格
Public Property Cells(ByVal hInt_Row As Integer,ByVal hInt_Col As Integer) As Object
Get
Return xlSheet.Cells(hInt_Row,hInt_Col)
End Get
Set(ByVal value As Object)
xlSheet.Cells(hInt_Row,hInt_Col) = value
End Set
End Property
'获取一组单元格
Public Property Cells(ByVal hStr_RowCol As String) As Object
Get
Return xlSheet.Range(hStr_RowCol)
End Get
Set(ByVal value As Object)
xlSheet.Range(hStr_RowCol) = value
End Set
End Property
Public Sub Copy(ByVal hStr_Range_From As String,ByVal hStr_Range_End As String)
xlSheet.Range(hStr_Range_From).Copy(xlSheet.Range(hStr_Range_End))
End Sub
Public Property SheetName() As Object
Get
Return xlSheet.Name
End Get
Set(ByVal value As Object)
xlSheet.Name = value
End Set
End Property

End Class

小弟写的导出EXCEL代码:
Dim app As New Excel.Application
Dim b As Excel.Workbook = app.Workbooks.Add
Dim s1 As Excel.Worksheet = b.Worksheets("sheet1")
Dim ml As String
Dim ml2 As String
Dim colindex As Integer
Dim rowindex As Integer
Dim bb As String
bb = FolderBrowserDialog1.ShowDialog()
If bb = 1 Then
ml = FolderBrowserDialog1.SelectedPath
ml2 = ml & "ERP即时库存"
For colindex = 0 To DataGridView1.ColumnCount - 1
s1.Cells(1,colindex + 1) = DataGridView1.Columns(colindex).HeaderCell.Value
Next

For rowindex = 1 To DataGridView1.Rows.Count - 1
For colindex = 0 To DataGridView1.Columns.Count - 1
s1.Cells(rowindex + 1,colindex + 1) = DataGridView1.Rows(rowindex - 1).Cells(colindex).Value.ToString
Next
Next
b.SaveAs(ml2)
b.Close()
End If

public function daochu()
Try

dg_daochu.Caption = "<font size=3 color=blue>客户信息表</font>"
HttpContext.Current.Response.Charset = "GB2312"
Response.ContentEncoding = System.Text.Encoding.GetEncoding("GB2312")
HttpContext.Current.Response.ContentType = "application/ms-excel"
HttpContext.Current.Response.AppendHeader("Content-Disposition","attachment;filename=customers.xls")
dg_daochu.Page.EnableViewState = False
Dim tw As System.IO.StringWriter = New System.IO.StringWriter
Dim hw As System.Web.UI.HtmlTextWriter = New System.Web.UI.HtmlTextWriter(tw)
dg_daochu.RenderControl(hw)
HttpContext.Current.Response.Write(tw.ToString)
HttpContext.Current.Response.End()

Catch Ex As Exception

End Try
end function

看花了!!
顶!

小数据导出还行,数据多了会慢 正常情况下应该把excel作为数据源操作,这样速度就不会慢 以下代码只需传Datatable和保存文件路径就OK Public Sub DtToXls(ByVal Table As DataTable,ByVal DefFileName As String) Dim MyOleDbCn As New System.Data.OleDb.OleDbConnection Dim MyOleDbCmd As New System.Data.OleDb.OleDbCommand Dim MyTable As New DataTable Dim intRowsCnt,intColsCnt As Integer Dim strSql As String,strFlName As String Dim Fso As New System.Object If Table Is Nothing Then MessageBox.Show("未取得數據，無法導出","導出錯誤",MessageBoxButtons.OK,MessageBoxIcon.Error) Exit Sub End If MyTable = Table If MyTable.Rows.Count = 0 Then MessageBox.Show("未取得數據，無法導出",MessageBoxIcon.Error) Exit Sub End If Dim FileName As String Dim SaveFileDialog As New SaveFileDialog SaveFileDialog.InitialDirectory = My.Computer.FileSystem.SpecialDirectories.MyDocuments SaveFileDialog.Title = "保存為" SaveFileDialog.Filter = ".xls|*.xls" SaveFileDialog.FileName = DefFileName If (SaveFileDialog.ShowDialog() = System.Windows.Forms.DialogResult.OK) Then FileName = SaveFileDialog.FileName ' TODO: 在此加入開啟檔案的程式碼。 End If If FileName = "" Then Exit Sub strFlName = FileName If Dir(FileName) <> "" Then Kill(FileName) End If Try Windows.Forms.Cursor.Current = System.Windows.Forms.Cursors.WaitCursor MyOleDbCn.ConnectionString = "Provider=Microsoft.Jet.OleDb.4.0;" & _ "Data Source=" & strFlName & ";" & _ "Extended ProPerties=""Excel 8.0;HDR=Yes;""" MyOleDbCn.Open() MyOleDbCmd.Connection = MyOleDbCn MyOleDbCmd.CommandType = CommandType.Text '第一行插入列标题 strSql = "CREATE TABLE " & DefFileName & "(" For intColsCnt = 0 To MyTable.Columns.Count - 1 If intColsCnt <> MyTable.Columns.Count - 1 Then strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & " text," Else strSql = strSql & ChangeChar(MyTable.Columns(intColsCnt).Caption) & " text)" End If Next MyOleDbCmd.CommandText = strSql MyOleDbCmd.ExecuteNonQuery() '插入各行 For intRowsCnt = 0 To MyTable.Rows.Count - 1 strSql = "INSERT INTO " & DefFileName & " VALUES('" For intColsCnt = 0 To MyTable.Columns.Count - 1 If intColsCnt <> MyTable.Columns.Count - 1 Then strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "','" Else strSql = strSql & ChangeChar(MyTable.Rows(intRowsCnt).Item(intColsCnt)) & "')" End If Next MyOleDbCmd.CommandText = strSql MyOleDbCmd.ExecuteNonQuery() Next MessageBox.Show("数据已经成功导入EXCEL文件" & strFlName,"数据导出",MessageBoxIcon.Information) Catch ErrCode As Exception MsgBox("错误信息：" & ErrCode.Message & vbCrLf & vbCrLf & _ "引发事件：" & ErrCode.TargetSite.ToString,MsgBoxStyle.OkOnly + MsgBoxStyle.Information,"错误来源：" & ErrCode.Source) Exit Sub Finally MyOleDbCmd.Dispose() MyOleDbCn.Close() MyOleDbCn.Dispose() 'Me.Cursor.Current = System.Windows.Forms.Cursors.Default End Try End Sub Public Function ChangeChar(ByVal Sqlchar) As String If Convert.IsDBNull(Sqlchar) Then ChangeChar = " " Exit Function End If Dim tStr As String tStr = Replace(Sqlchar,"'",Chr(39) + Chr(39)) tStr = Replace(tStr,"|","_") ChangeChar = tStr End Function