'//還沒驗證
'to prevent error for directory already created with mkdir line
On Error Resume Next
' Initialize variables
Dim session As NotesSession
Dim curdb As NotesDatabase
Dim ClientDataPath As String
Dim IdFileOnClient As String
Dim idFileNewOnClient As String
Dim ClientLocationDoc As String
Dim ClientMailSrv As String
Dim ClientMailFile As String
Dim wordobj As Variant
'Get session and database
Set session = New NotesSession
Set curdb = session.CurrentDatabase
' Get Client notes.ini information
ClientLocationDoc = session.GetEnvironmentString("Location",True)
ClientMailSrv = session.GetEnvironmentString("MailServer",True)
ClientMailFile = session.GetEnvironmentString("MailFile",True)
ClientDataPath = session.GetEnvironmentString("Directory",True)
IdFileOnClient = session.GetEnvironmentString("KeyFilename",True)
If Instr(idFileOnClient,"\")<>0 Then
IdFileNewOnClient = Strrightback(IdFileOnClient,"\")
Else
idFileNewOnClient = IdFileOnClient
End If
'Create first text file
' Used to create first file
fileNum% = Freefile()
Mkdir "c:\stagingr6"
fileName$ = "c:\stagingr6\notes.ini"
' Write But notes.ini information.
Open fileName$ For Output As fileNum%
Print #fileNum%, "[Notes]"
Print #fileNum%, "KitType=1"
Print #fileNum%, "SharedDataDirectory=C:\Documents and Settings\All Users\Application Data\Lotus\Notes\Data\Shared"
Print #fileNum%, "Directory=C:\Documents and Settings\%username%\Application Data\Lotus\Notes\Data\Shared"
Print #fileNum%, "MailServer=" & ClientMailSrv
Print #fileNum%, "MailFile=" & ClientMailFile
Print #fileNum%, "Location=" & ClientLocationDoc
Print #fileNum%, "StackedIcons=1"
Print #fileNum%, "TCPIP=TCP,0,15,0"
Print #fileNum%, "Ports=TCPIP"
Print #fileNum%, "KeyFileName=" & IdFileNewOnClient
Print #fileNum%, "TemplateSetup=600400"
Print #fileNum%, "Setup=650200"
Close fileNum%
' Used to create second file
fileNum2% = Freefile()
fileName2$ = "c:\stagingr6\dataFolder.txt"
' Write put data folder location
Open fileName2$ For Output As fileNum2%
Print #fileNum2%, ClientDataPath
Close fileNum2%
End Sub
Function CM_exportToTxt() As Integer
回覆刪除'//匯出txt檔
On Error Goto errorhandler
Call jmcf_SetNewVars()
'
CM_exportToTxt = True
Dim col As NotesDocumentCollection
Dim doc As NotesDocument
Dim i As Integer, sFileNm As String
Set col = jmcdb.UnprocessedDocuments
Dim txt As String
Dim fileNum As Integer
Dim counter As Integer
' Get an unused file number so LotusScript can open a file.
fileNum% = Freefile()
counter% = 0
sFileNm = "D:\tmp\temp" + Format(Now(), "yyyymmddhhmmss") + ".txt"
'Open "D:\tmp\temp.txt" For Output As fileNum
Open sFileNm For Output As fileNum
Do While Not Eof(fileNum%)
' Read each line of the file.
Line Input #fileNum%, txt$
' Increment the line count.
counter% = counter% + 1
Loop
Seek fileNum%, 1
For i = 1 To col.Count
Set doc = col.GetNthDocument(i)
'//"2010049P" "A2086M_12_90HV"
Print #fileNum, Chr(34) + doc.SerialNumber(0) + Chr(34) + Chr(9) + Chr(34) + doc.PartNo(0) + Chr(34)
Next
Close fileNum%
If CM_exportToTxt Then
Messagebox "export ok!", 0, "attention"
End If
TheEnd:
Exit Function
ErrorHandler:
CM_exportToTxt = False
Print "lib: CM.ReferenceAction4BA: CM_exportToTxt error line = " + Cstr(Erl) + ", error = " + Error$
Resume TheEnd
End Function