新需求:数据处理型网站

重难点待解决:

一,本地EXCEL文件上传至网站数据库;

二,SQL语句中的多变量带入;

三,HTML的FORM中,复选框的使用。

--------------------------------

四,直接连接SAP,取数据。

Dim oConnection  As Object
Dim ofun As Object
Dim func As Object

Private Sub Form_Load()
    Dim result As Boolean
    
    Set oFunction = CreateObject("SAP.LogonControl.1")
     Set oConnection = oFunction.NewConnection
     oConnection.Client = "100"
     oConnection.Language = "en"
     oConnection.user = "devusr2"
     oConnection.Password = "179521"
     oConnection.ApplicationServer = "10.1.2.105"
     oConnection.SystemNumber = "00"
     result = oConnection.Logon(0, True)
    
     If result Then
         'boolLogon = True
         MsgBox "SAP R/3 Access OK ", vbInformation + vbOKOnly
         TxtNum1 = "5"
         TxtNum2 = "7"
     Else
         Set oFunction = Nothing
         Set oConnection = Nothing
         'boolLogon = False
         MsgBox "No access to R/3 System", vbInformation + vbOKOnly, "Error"
         End
        
     End If

End Sub

Private Sub CmdAdd_Click()
    Set ofun = CreateObject("SAP.FUNCTIONS")
    Set ofun.Connection = oConnection
    Set func = ofun.Add("ZLIRFC")    'function name
    'set parm
    func.Exports("AAA") = Val(Trim(TxtNum1.Text))
    func.Exports("BBB") = Val(Trim(TxtNum2.Text))
    If func.call Then
        'Set obj = func.tables.item(******)         'tablename
        
'        rows = obj.rowcount
'        If rows = 0 Then Exit Sub
'        MsgBox obj.Value(row, 1)
'    Next
       LabAdd.Caption = "Num1 + Num2 = " & func.Imports("CCC")
    End If
    Set ofun = Nothing
    Set func = Nothing

End Sub

-------------------ASP读取EXCEL文件-------------------

<%
'On Error Resume Next
'导入Excel电子表格数据到SQL Sever数据库 By Dicky 2004-12-27 16:41:12 QQ:25941
Function Open_Conn(SqlDatabaseName,SqlPassword,SqlUsername,SqlLocalName,SqlConn)
'创建数据库连接对象并打开数据库连接
 Dim ConnStr
 'SQL Server数据库连接参数:数据库名、用户密码、用户名、连接名(本地用local,外地用IP)
 ConnStr = "Provider=Sqloledb; User ID=" & SqlUsername & "; Password=" & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source=" & SqlLocalName & ";"
 Set SqlConn = Server.CreateObject("ADODB.Connection")
 SqlConn.Open ConnStr
 If Err Then
  Err.Clear
  Set SqlConn = Nothing
  Response.Write "数据连接错误!"
  Response.End
 End If
End Function

Function Close_Conn(SqlConn)
'关闭数据库连接并清除数据库连接对象
 If IsObject(SqlConn) Then
  SqlConn.Close
  Set SqlConn = Nothing
 End If
End Function

Call Open_Conn("数据库名称","数据库用户的密码","数据库服务器用户名","服务器IP地址",SqlConn) '打开SQL Server数据库连接

Function Get_EMP_CnName(NTACCNT)
'根据用户NT帐号得到用户中文名
 Dim Sql,Rs
 Sql = "Select EMP_CNAME From RF_EMPLOYEE Where EMP_NTACCNT='"&NTACCNT&"'"
 Set Rs = Server.CreateObject("Adodb.RecordSet")
 Rs.Open Sql,SqlConn,1,1
 If Rs.Eof Then
  Get_EMP_CnName = ""
 Else
  Get_EMP_CnName = Rs("EMP_CNAME")
 End If
 Rs.Close
 Set Rs = Nothing
End Function %>

<html>
<head>
<title>导入Excel电子表格数据到SQL Sever数据库</title>
<body bgcolor="#ACD9AF">
<center><b>导入Excel电子表格数据到SQL Sever数据库</b></center>
<FORM METHOD="POST" name="form1">
请选择数据源: <input type="file" name="File" size="40" title="请选择需要导入的Excel文件">
<br>
请选择数据库目标表:
<SELECT NAME="Table" title="请选择需要导入数据的表">
 <option></option>
<% Dim RsSqlDatabaseTable
 Set RsSqlDatabaseTable = SqlConn.OpenSchema(20)
 Do While Not RsSqlDatabaseTable.Eof %>

 <option<%If Trim(Request("Table"))=RsSqlDatabaseTable(2) Then Response.Write " selected"%>>
        <%=RsSqlDatabaseTable(2)%>
 </option>
<% RsSqlDatabaseTable.MoveNext:Loop
 Set RsSqlDatabaseTable = Nothing %>
</SELECT>
</FORM>
<font color=blue>导出过程中,请勿刷新页面!</font><br>
<input type=submit name=submit value="开始导入">
<%
If Right(Trim(Request("File")),3) = "xls" Then
 Response.Write "<font color=red>您所导出的Excel文件是:"&Trim(Request("File"))&"</font><br>"
End If
'=====================ASP读取EXCEL注事项=====================================
'i)将Excel97或Excel2000生成的XLS文件(book)看成一个数据库,其中的每一个工作表(sheet)看成数据库表
'ii)ADO假设Excel中的第一行为字段名.所以你定义的范围中必须要包括第一行的内容
'iii)Excel中的行标题(即字段名)不能够包含数字. Excel的驱动在遇到这种问题时就会出错的。例如你的行标题名为“F1”
'iiii)如果你的Excel电子表格中某一列同时包含了文本和数字的话,那么Excel的ODBC驱动将不能够正常, 处理这一行的数据类型,你必须要保证该列的数据类型一致
'E-MAIL:Kaxue@Hotmail.com QQ:484110 HOMEPAGE:www.Flyday.net
'整理时间:Thursday, May 23, 2002 5:54 PM WIN2000SERVER+IIS5 测式通过
'============================================================================
If Trim(Request("File")) = "" Then
 Response.Write "<font color=red>对不起,请选择需要导出的Excel文件!</font>"
 Response.End
ElseIf Right(Trim(Request("File")),3) <> "xls" Then
 Response.Write "<font color=red>对不起,请确定您需要导出的是Excel文件!</font>"
 Response.End
Else
 '列出所选择的Excel文件中的所有工作表
 Dim ExeclFile,objExcelApp,objExcelBook
 ExeclFile = Trim(Request("File"))
 Set objExcelApp = CreateObject("Excel.Application")
 objExcelApp.Quit
 objExcelApp.DisplayAlerts = False '不显示警告
 objExcelApp.Application.Visible = False '不显示界面
 objExcelApp.WorkBooks.Open(ExeclFile)
 set objExcelBook = objExcelApp.ActiveWorkBook
 reDim arrSheets(objExcelBook.Sheets.Count)
 For i=1 to objExcelBook.Sheets.Count
  arrSheets(i) = objExcelBook.Sheets(i).Name
'  Response.Write arrSheets(i)
 Next
 objExcelApp.Quit
 Set objExeclApp = Nothing
 '列出所选择的Excel文件中的所有工作表
End If

Dim Conn,Driver,DBPath,Rs,SqlInsert,SqlDelete
'建立Connection对象
Set Conn = Server.CreateObject("ADODB.Connection")
Driver = "Driver={Microsoft Excel Driver (*.xls)};"
'DBPath = "DBQ=" & Server.MapPath( "HRB.xls" )
DBPath = "DBQ=" & Trim(Request("File"))
'调用Open 方法打开数据库
Conn.Open Driver & DBPath

'DSN连接方式
'Conn.Open "Dsn=test"
'注意 表名一定要以下边这种格式 "[表名$]" 书写
For i = 1 To UBound(arrSheets)'開始循環所有工作表
 Sql = "SELECT * FROM ["& arrSheets(i) &"$] "
 Set Rs = Conn.Execute(Sql)
 
 If Rs.Eof And Rs.Bof Then
  Response.write "没有找到您需要的数据!!<br>"
 Else
'  Response.Write "<font color=blue>工作表:</font><font color=green>"&arrSheets(i)&"</font><br>"
  Do While Not Rs.Eof
   SqlInsert = "Insert Into "&Trim(Request("Table"))&" (EDG_Project_Name,EDG_Project_No,EDG_Project_VM,EDG_Project_VM_CnName,EDG_Project_M,EDG_Project_M_CnName,EDG_Project_Director,EDG_Project_Director_CnName) Values ('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(2))&"("&Get_EMP_CnName(Trim(Rs(2)))&")"&"','"&Trim(Rs(3))&"','"&Trim(Rs(3))&"("&Get_EMP_CnName(Trim(Rs(3)))&")"&"','"&Trim(Rs(4))&"','"&Trim(Rs(4))&"("&Get_EMP_CnName(Trim(Rs(4)))&")"&"')"
   '此处插入的值根据实际数据库结构进行调整
   SqlConn.Execute(SqlInsert)'插入Excel表格
  Rs.MoveNext
  Loop
  Response.Write "<font color=red>恭喜,成功導出Excel文件中工作表[</font><font color=blue>"&arrSheets(i)&"</font><font color=red>]的數據到SQL Server數據表[<font color=blue>"&Trim(Request("Table"))&"</font>]中!^_^</font><br>"
 End If

 Rs.Close
 Set Rs = Nothing
Next'循环所有工作表结束

Call Close_Conn(Conn) '关闭Excel数据库连接
Call Close_Conn(SqlConn) '关闭SQL Server数据库连接 %>
</body>
</html>

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值