LOSTUS NOTES 没用过,参考SQL导入Excel和Access: '引用 Microsoft ActiveX Data Objects 2.X Library Private Sub Command1_Click() Dim cn As New ADODB.Connection cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=jtaf;Password=登陆密码;Initial Catalog=sql里的数据库;Data Source=sql服务器别名或IP" cn.CursorLocation = adUseClient cn.Open '导入Excel用下面这句: cn.Execute("insert into OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;hdr=yes;database=c:\Test.xls;','select * from [Sheet1$]') select top 25 * from table1") '导入Access用下面这句: 'cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0',';database=c:\Test.mdb','select * from 表1') select top 25 * from table1") cn.Close Set cn = Nothing End Sub cn.Close Set cn = Nothing End Sub
xlapp.Selection.Font.Size = 9 xlapp.Selection.NumberFormatLocal = "@" '设置纯文本,避免对数值做科学计数处理 '自动调整列宽 If FisAutoFit Then xlapp.Selection.Columns.AutoFit For i = 1 To cols+1 xlApp.Range(xlSheet.Cells(1,i), xlSheet.Cells(1,i)).Select If xlapp.Selection.ColumnWidth > 25 Then xlapp.Selection.ColumnWidth = 25 End If Next End If
xlApp.Range(xlSheet.Cells(1,1), xlSheet.Cells(rows-1,cols+1)).Select 'xlEdgeLeft:xlEdgeRight:xlEdgeTop:xlEdgeBottom:xlInsideHorizontal:xlInsideVertic al分别为 1,2,3,4,7,8 If FisShowGridLine Then '显示表格边线 For i = 1 To 8 Select Case i Case 5, 6 : '5,6是斜线 Case Else With xlapp.Selection.Borders( i ) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Select Next End If xlSheet.Cells(1,1).Select End Sub
to faysky2:抢分不一定是好习惯,当你帖出上面的代码,显示了你对DOMINO的一无所知,因为domino数据库的本质是文档数据库,而不是关系数据库,这是最最最基础的东西.to WallesCai:可以导的,用odbc就可以,帖那段似乎是那找的:P LotusScript本身就是和VB最相近的,是不是VB演变来的,我忘记了,好象是 可惜B/S结构不支持
Private Sub Command1_Click() Dim db1 As Database Set db1 = OpenDatabase("c:\db\po_print.mdb")Dim rec As Recordset Set rec = db1.OpenRecordset("select * from PURCHASE_REQ") Dim session As Object Dim db As Object Dim view As Object Dim doc As Object Set session = CreateObject("notes.notessession")Set db = session.GetDatabase("cnm1/wuscn", "wuscnap\mainpurch.nsf")Set view = db.GetView("daxing")Set doc = view.GetFirstDocument Dim ss As Date Dim s1 As Variant Dim s2 As Variant Dim s3 As Variant Dim s4 As Variant Dim s5 As Variant Dim s6 As Variant Dim s7 As Variant Dim s8 As Variant Dim s9 As Variant Dim s10 As Variant Dim s11 As Variant Dim TEST As String While Not (doc Is Nothing) rec.AddNew s1 = doc.GetItemValue("prdate") '請購日期 s2 = doc.GetItemValue("PRNO1") '請購單號 s3 = doc.GetItemValue("itemname1") '料號 s4 = doc.GetItemValue("itemspec1") '品名 s5 = doc.GetItemValue("provide") '供應商 s6 = doc.GetItemValue("itemqty1") '數量 s7 = doc.GetItemValue("bibie") '幣別 s8 = doc.GetItemValue("pretotprice1") '總金額 s9 = doc.GetItemValue("caigouzhe1") '采購員 s10 = doc.GetItemValue("itemmemo1") '備注 s11 = doc.GetItemValue("prdesc") '用途
'引用 Microsoft ActiveX Data Objects 2.X Library
Private Sub Command1_Click()
Dim cn As New ADODB.Connection
cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=jtaf;Password=登陆密码;Initial Catalog=sql里的数据库;Data Source=sql服务器别名或IP"
cn.CursorLocation = adUseClient
cn.Open '导入Excel用下面这句:
cn.Execute("insert into OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;hdr=yes;database=c:\Test.xls;','select * from [Sheet1$]') select top 25 * from table1") '导入Access用下面这句:
'cn.Execute ("insert into OpenRowSet('microsoft.jet.oledb.4.0',';database=c:\Test.mdb','select * from 表1') select top 25 * from table1")
cn.Close
Set cn = Nothing
End Sub cn.Close
Set cn = Nothing
End Sub
当然,你可以通过象创建EXCEL或WORD对象一样的方法来创建一个NOTES对象,但是你很难把一个邮件对象所包含的内容导出到一个表状数据库内(grid或table),因为光是邮件对象本身就比较难以处理,它既包含文档,又可能有附件,或者是多附件,甚至还有超链接.
如果你只是单单用来将收件人,发件人,信头最通用的部分导出,那还是可以的.
或者还有个更简单的方法,你在安装NOTES客户端的时候选择安装开发工具,那么就可以直接使用NOTES自带的NOTES SCRIPT语言来写相同的程序了.
尝试之后,你不要吃惊,NOTES SCRIPT在开发界面和语言特性上和VB6几乎是100%相同的,连API的支持都不例外.(除了它不能生成EXE文件)
不过导入似乎没必要经过VB啊,比如导到excel录一段宏,将将宏代码拷贝到LotusScript就可以了给你一个示范:
Const xlThin = 2
Const xlAutomatic = 1
Const xlContinuous = 1
Const xlCenter = 3Sub setRange()
Dim i As Integer, j As Integer
Dim tmpArray As Variant
xlApp.Range(xlSheet.Cells(1,1), xlSheet.Cells(rows-1,cols+1)).Select
xlapp.Selection.Font.Size = 9
xlapp.Selection.NumberFormatLocal = "@" '设置纯文本,避免对数值做科学计数处理
'自动调整列宽
If FisAutoFit Then
xlapp.Selection.Columns.AutoFit
For i = 1 To cols+1
xlApp.Range(xlSheet.Cells(1,i), xlSheet.Cells(1,i)).Select
If xlapp.Selection.ColumnWidth > 25 Then
xlapp.Selection.ColumnWidth = 25 End If
Next
End If
xlApp.Range(xlSheet.Cells(1,1), xlSheet.Cells(rows-1,cols+1)).Select
'xlEdgeLeft:xlEdgeRight:xlEdgeTop:xlEdgeBottom:xlInsideHorizontal:xlInsideVertic al分别为 1,2,3,4,7,8
If FisShowGridLine Then '显示表格边线
For i = 1 To 8
Select Case i
Case 5, 6 : '5,6是斜线
Case Else
With xlapp.Selection.Borders( i )
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Select
Next
End If xlSheet.Cells(1,1).Select
End Sub
LotusScript本身就是和VB最相近的,是不是VB演变来的,我忘记了,好象是
可惜B/S结构不支持
Dim db1 As Database
Set db1 = OpenDatabase("c:\db\po_print.mdb")Dim rec As Recordset
Set rec = db1.OpenRecordset("select * from PURCHASE_REQ")
Dim session As Object
Dim db As Object
Dim view As Object
Dim doc As Object
Set session = CreateObject("notes.notessession")Set db = session.GetDatabase("cnm1/wuscn", "wuscnap\mainpurch.nsf")Set view = db.GetView("daxing")Set doc = view.GetFirstDocument
Dim ss As Date
Dim s1 As Variant
Dim s2 As Variant
Dim s3 As Variant
Dim s4 As Variant
Dim s5 As Variant
Dim s6 As Variant
Dim s7 As Variant
Dim s8 As Variant
Dim s9 As Variant
Dim s10 As Variant
Dim s11 As Variant
Dim TEST As String
While Not (doc Is Nothing) rec.AddNew
s1 = doc.GetItemValue("prdate") '請購日期
s2 = doc.GetItemValue("PRNO1") '請購單號
s3 = doc.GetItemValue("itemname1") '料號
s4 = doc.GetItemValue("itemspec1") '品名
s5 = doc.GetItemValue("provide") '供應商
s6 = doc.GetItemValue("itemqty1") '數量
s7 = doc.GetItemValue("bibie") '幣別
s8 = doc.GetItemValue("pretotprice1") '總金額
s9 = doc.GetItemValue("caigouzhe1") '采購員
s10 = doc.GetItemValue("itemmemo1") '備注
s11 = doc.GetItemValue("prdesc") '用途
rec.Fields(1) = s1(0)
rec.Fields(2) = s2(0)
rec.Fields(3) = s3(0)
rec.Fields(4) = Trim(Left$(s4(0), 25))
rec.Fields(5) = s5(0)
rec.Fields(6) = IIf(Len(Trim(s6(0))) = 0, 0, Trim(s6(0)))
rec.Fields(7) = Trim(s7(0))
rec.Fields(8) = IIf(Len(Trim(s8(0))) = 0, 0, Trim(s8(0)))
rec.Fields(9) = s9(0)
rec.Fields(10) = Trim(s10(0))
rec.Fields(11) = Left$(Trim(s11(0)), 25)
rec.Update
Set doc = view.GetNextDocument(doc)
Wend
MsgBox "ok!"
End Sub已經解決,但是不清楚怎么用帳號登陸,只能更據本机的LOTUS帳號,要是沒有權限的用戶,怎么動態在內部用帳號連接?
-----
我也想知道