ASP批量导入EXCEL中数据入库

最近搞了一个邮件管理系统，有大量邮件，要输入这些邮箱进数据库，一个个的手工输入，是很不现实的，只能大批量导入，由于邮箱是存放在EXCEL文件中，只能从EXCEL文件中导入！

看看是如何导入的！

本人写了一个过程，具体代码如下：

文件GetExcelData.asp
<%
Sub GetExcelData(excelPath)
Dim excelConn,excelDriver,excelRs,excelSql
Dim toMailRs,toMailSql

excelDriver="Driver={Microsoft Excel Driver (*.xls)};DriverId=790; DBQ="&Server.MapPath(excelPath)
Set excelConn=Server.CreateObject("Adodb.Connection")
excelConn.Open excelDriver

excelSql="select * from [Sheet1$]"

Set excelRs=excelConn.Execute(excelSql)
While Not excelRs.Eof

toMailSql="select * from email where email_name='"&Trim(excelRs(0))&"'"
Call OpenRs(toMailRs,toMailSql,1)
If toMailRs.Eof Then

'这一步是写入数据库，具体数据库表请您修改
toMailSql="insert into email(email_name,email_user_name,email_add_date,email_sys_admin,email_sys_name,email_open)"
toMailSql=toMailSql&" values('"&Trim(excelRs(0))&"','未知',"
toMailSql=toMailSql&"'"&Now()&"',"&CInt(Session("sysid"))&",'"&Trim(Session("sysname"))&"',true)"
'----------------------------------------------------------------
conn.Execute(toMailSql)
'Response.Write toMailSql
End If
Call CloseRs(toMailRs)

excelRs.MoveNext
Wend

excelRs.Close
Set excelRs=Nothing
excelConn.Close

End Sub

'Call GetExcelData("/fileUpLoad/email.xls")
%>

使用方法：

If SafeRequest("act")="badd2" Then
Dim eXlsFilePath
eXlsFilePath=SafeRequest("exls")
Call GetExcelData(eXlsFilePath)
Call Alert("您批量导入邮箱成功了！","addEmail.asp")
End If

注意：EXCEL中Sheet1$中A列为邮箱名，相当我们数据库中第一列，同时还要注意，读取数据时，A1行是不读取，所以数据应写在A2行以下，因为读取数据是从A2行开始，所以A1行写属性名如”邮箱名“，以区别，当作字段名，相当我们数据库字段，此实例中，EXCEL表结构如下：

           A                          B     C
------------------------------------------------
A1   邮箱名

A2   xxxx@163.com

A3   kkkkk@21cn.com

说完了，您可以试一下！



.............................................................

protected void Button1_Click(object sender, System.EventArgs e)
{
string XLS_Path="";
string XLS_Name = MakeFileName();
string fileExtName = "";
if(File1.PostedFile.ContentLength >0)
{
try
{
fileExtName = File1.PostedFile.FileName.Substring(File1.PostedFile.FileName.LastIndexOf("."));
if(fileExtName!=".xls"||fileExtName.Length<1)
{
Response.Write( "");
return;
}
File1.PostedFile.SaveAs(Server.MapPath("../uploadexcel/")+XLS_Name+fileExtName);
XLS_Path =Server.MapPath("../uploadexcel/")+ XLS_Name+fileExtName;
}
catch(Exception ex)
{
Response.Write(ex.ToString());
}
}
else
{
Response.Write( "");
return;
}
string ConStr=System.Configuration.ConfigurationManager.AppSettings["ConnString"];
SqlConnection Conn=new SqlConnection(ConStr);
string mystring="Provider = Microsoft.Jet.OLEDB.4.0 ; Data Source = '"+XLS_Path+"'"+";Extended Properties=Excel 8.0";
OleDbConnection cnnxls = new OleDbConnection (mystring);
OleDbDataAdapter myDa =new OleDbDataAdapter("select * from [Sheet1$]",cnnxls);
DataSet myDs =new DataSet();
try
{
myDa.Fill(myDs);
}
catch
{
Response.Write( "");
return;
}
if(myDs.Tables[0].Rows.Count<=0)
{
Response.Write( "");
return;
}

int []zjid=new int[myDs.Tables[0].Rows.Count];
string strSql = "";
string CnnString="Provider=SQLOLEDB;"+ConStr;
OleDbConnection conn =new OleDbConnection(CnnString);
OleDbCommand myCmd =null;

...................................................................................

====================================================================='==========
''''''''''''''''''H*F*W 2009 Execl数据导入SQL SERVER''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''Execl数据导入 SQL SERVER VBS脚本过程
'''''''''''广告:-) QQ:176469428 愿能结识拥有共同兴趣的朋友
''''''实用时根据情况自己修改 主要为字段信息
'''导入数据 过程传入 数据库服务器，登陆用户，登陆密码，数据库，数据表，Execl表格文件路径
Sub HFWExlToSQL(Hserver,Huid,Hpwd,Hdb,HTab,HExlsPath)
Dim hxls '调用 Execl
Dim Hxlbook '打开 Execl
Dim Hxlsheet ' 建立 表格
Dim i '表格记录变量
Dim Cn '数据库连接
Dim Rn '数据库查询
Dim SQLcmd '数据库查询语句
On Error GoTo HFWErrHelp '如果错误则转到错误处理位置执行
'下面一句 先检查文件是否存在
'If Dir(HExlsPath) = "" Then MsgBox "文件" & HExlsPath & "不存在", vbOKOnly, "H*F*W": Exit Sub'晕死 这句在 VBS 中不能用 VB中可以
Set hxls = CreateObject("Excel.application")
Set Hxlbook = hxls.Workbooks.Open(HExlsPath)
Set Hxlsheet = Hxlbook.WorkSheets(1)
Set Cn = CreateObject("ADODB.Connection") '建立数据库连接
Set Rn = CreateObject("ADODB.Recordset") '建立查询
Cn.Open "driver=SQL Server;server=" & Hserver & ";UID=" & Huid & ";PWD=" & Hpwd & ";database=" & Hdb
If Err.Number <> 0 Then MsgBox "数据库连接错误!", vbOKOnly, "H*F*W": Exit Sub '数据库连接错误退出过程
i = 1 'Execl 中记录已 1 开始
While Hxlsheet.cells(i, 1) <> "" '这里的SQL命令 要根据 实际情况进行修改
SQLcmd = "("
'''''''''''''''''''z这下面的字段要根据 实际情况修改''''''''''''''''''''''''''''''
SQLcmd = SQLcmd & Hxlsheet.cells(i, 1) & ",'" '字段 1 ID
SQLcmd = SQLcmd & Hxlsheet.cells(i, 2) & "','" '字段 2 name
SQLcmd = SQLcmd & Hxlsheet.cells(i, 3) & "','" '字段 3 password
SQLcmd = SQLcmd & Hxlsheet.cells(i, 4) & "','" '字段 4 Sex
SQLcmd = SQLcmd & Hxlsheet.cells(i, 5) & "','" '字段 5 TEL
SQLcmd = SQLcmd & Hxlsheet.cells(i, 6) & "')" '字段 6 Cname
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SQLcmd = "insert into Husers(id,name,password,Sex,TEL,Cname)values" & SQLcmd
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Rn.Open SQLcmd, Cn, , , adCmdText
''''''''''动态跟中导入过程中的 成功 与 失败
''If Err.Number = 0 Then
'' Text1.SelText = i & " ------->OK" & vbCrLf
''Else
'' Text1.SelText = i & " ------->Fail" & vbCrLf
''End If
'''''''''''''''''''''''''''''''''''''''''''
i = i + 1
Wend
Set Hxlsheet = Nothing
Set Hxlbook = Nothing
hxls.quit '关闭Execl 否则进程不被关闭并且文件被一直占用
Cn.Close '关闭连接
MsgBox "操作完成！~OK"
Exit Sub
HFWErrHelp: ' 下面是错误处理过程
If Cn.State <= 0 Then Cn.Close: MsgBox "连接关闭！"
MsgBox "发生错误！" & vbCrLf & "错误号: " & Err.Number & vbCrLf & Err.HelpContext & vbCrLf & Err.Description
End Sub
'====================================================================='====================================

上一篇: win2003server中IIS中使用主机头建立虚拟主机
下一篇: ASP里，将Excel导入到Access数据库
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志: