Is there a way to export lotus notes view into csv file with string qualifier as anything except double quotes like a tilde(~)?
Thanks.
As far as I know (and Googling I was not able to anything to prove me wrong), using File->Export, no. There are other options. One is to write an agent to traverse the view and write out each column. That way you have complete control over all of it. Another idea might be to create a web-accessible version of the view formatted how you would like. You'd have to explicitly use the "count=" URL parameter to get all the documents though.
You could modify the code linked below to use different delimiters:
http://blog.texasswede.com/export-notes-view-to-excel-with-multi-value-fields/
This would be the function to modify:
Public Function CSVArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |"| + Replace(h,Chr$(13),"\n") + |",|
End ForAll
rowarray(cnt) = Left$(textrow,Len(textrow)-1)
cnt = cnt + 1
End ForAll
CSVArray = rowarray
End Function
Just replace the line
textrow = textrow + |"| + Replace(h,Chr$(13),"\n") + |",|
with
textrow = textrow + Replace(h,Chr$(13),"\n") + |~|
Related
I am programming a kind of parser which reads an Excel table and then creates a
List of processes with some properties like Name, StartTime, EndTime etc.
For this I have a class Process and in the main file, I have a processList (Scripting.Dictionary), where I put the processes as I read the lines... For this assignment, the key is a String called MSID.
Now the problem is that for some reason, I am only able to access the Object from the Dictionary and alter its parameters inside one part of my If-ElseIf statement. In the other case, it throws 424-object required error and I have no idea why.
Here is the code
Sub ParseMessages()
' ITERATOR VARIABLES
Dim wb As Workbook, ws As Worksheet
Dim rowIter As Long, row As Variant
Dim A As Variant, B As Variant, C As Variant, D As Variant, E As Variant, F As Variant ' A,B,C,D,E,F variables for the cells of each row
' PROCESS PARAMETERS
Dim MSID As Variant
Dim StartTime As Variant
Dim EndTime As Variant
' OBJECTS
Dim process As process
Dim processList As Scripting.Dictionary ' DICTIONARY where the error happens
Set processList = New Scripting.Dictionary
Worksheets(1).Activate
'####### MAIN LOOP ######################################################
For rowIter = 1 To 11
row = Rows(rowIter)
A = row(1, 1)
B = row(1, 2)
C = row(1, 3)
D = row(1, 4)
E = row(1, 5)
F = row(1, 6)
Dim startIndex As Long, endIndex As Long, count As Long
' ------ PROCESSSTART -> MSID, processName, startTime
If (.....) Then
Debug.Print (vbNewLine & "Process start")
If (...) Then ' --MSID
startIndex = InStr(F, "Nr") + 3 '3 to skip "Nr "
endIndex = InStr(startIndex, F, "(")
count = endIndex - startIndex
MSID = Mid(F, startIndex, count)
StartTime = B
Debug.Print (StartTime & " -> " & MSID)
' **** MAKE new Process object, add to collection
Set process = New process
process.StartTime = StartTime
process.MSID = MSID
processList.Add MSID, process ' Add to the dictionary, KEY, VALUE
ElseIf (...) Then ' --ProcessName
startIndex = InStr(F, "=") + 2
endIndex = InStr(F, "<") - 1
count = endIndex - startIndex
processName = Mid(F, startIndex, count)
Debug.Print (processName)
' **** Add Name to the last element of the dictionary
processList(processList.Keys(processList.count - 1)).Name = processName 'get last Process Object
processList(MSID).Name = "Just Testing" ' !!!! here it works
Else
End If
' ------ END OF PROCESS ->
ElseIf (......) Then
startIndex = InStr(D, "MSID") + 5
endIndex = InStr(startIndex, D, "]")
count = endIndex - startIndex
MSID = Mid(D, startIndex, count)
EndTime = B
Debug.Print (EndTime & " End of process " & MSID)
' **** Add End time for the process from the collection, specified by MSID
Debug.Print ("Test of " & processList(MSID).Name) ' !!!!! Doesn't work
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime ' !!!!! Does not work
End If
Next
End Sub
So to specify the question - why is it that this works:
processList(MSID).Name = "Just Testing" ' !!!! here it works
And this doesn't:
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
If I first prove if the Object with the MSID key exists in the dictionary,
it's not found.
If processList.Exists(MSID) Then
Debug.Print ("Process exists, altering it...")
processList(MSID).Name = "Just Prooooooving" ' !!!!! Here doesn't work
processList(MSID).EndTime = EndTime
End If
But on the very first line where the condition is evaluated, I get something different by debug. It's THERE! See picture below
Debugging - MSID there but not able to access Dictionary entry with this as a key
Can you suggest how to solve this issue?
Thank you very much in advance for your help!
So... It's a bit shameful but after some hours of trying to solve this problem I found out,
that I added the Object to the list with MSID="124 " as Key.
When I tried to access, I of course used MSID with value "124".
Notice the difference? Yes, that space at the end.
The tricky part is - VBA debugger trims spaces at the end of Strings,
so it's actually impossible to see it. The same situation is if you print this out - impossible to see...
So in the end, I spent many hours looking for the answer, which is so simple :/
All I can do is to laugh about this.
I am trying to find the distance and travel time between multiple origins and destinations. For some reason, my code does not work at all. There are no errors, i just have nothing as output. See the attached Image for Excel worksheet.
Sub Origins_Destinations()
Dim a, b, i, Str As String
Dim lineS As Variant
On Error Resume Next
'Application.ScreenUpdating = False
With CreateObject("WinHttp.WinHttpRequest")
Dim iRow As Long: iRow = ThisWorkbook.Worksheets(1).Range("g65000").End(xlUp).Row
For j = 4 To iRow
b = ThisWorkbook.Worksheets(1).Range("b4" & j)
a = ThisWorkbook.Worksheets(1).Range("a4" & j)
.Open "GET", "https://maps.googleapis.com/maps/api/distancematrix/json?units=imperial&origins=" & a & " &destinations= " & b & " &key=MY_KEY", False
.Send
lineS = Split(.ResponseText, vbLf)
For k = 25 To UBound(lineS)
If Trim(lineS(k)) = """distance"" : {" Then
Exit For
End If
Next k
ThisWorkbook.Worksheets(1).Range("c" & j) = lineS(k + 1)
ThisWorkbook.Worksheets(1).Range("d" & j) = lineS(k + 5)
Application.Wait (Now + TimeValue("0:00:01"))
Next j
End With
Application.ScreenUpdating = True
End Sub
enter image description here
Any suggestions ?????
As far as I understand, the code below is what you're looking for to get you started. Enter your Google Maps API Key in the Constant at the top, and then run sub TestRun.
It will replace disallowed characters in the address you provided, then loads the JSON results from Google Matrix into a string, and then, since we're only looking for 1 or 2 values, it will use a messy cheater-method to location the values, that I can't guarantee will always work:
It finds the first occurrence of the word "distance", and then the first occurrence of the word "value" after that, move 3 more characters to the right, and then take whatever is between there and the next " " blank space, and converts it to a value, hopefully the distance in meters.
Then it repeats (from beginning of file) to find "duration" in seconds, the same method. Note that the distance and duration are being returned to variables "byref".
As I said, it's very convoluted, but you get what you pay for. (Normally I wouldn't share code this "yucky", but you're in my neighborhood, so, Go Canada!)
Option Explicit
'3333 University Way,Kelowna,BC,V1V 1V7
'1555 Banks Rd, Kelowna, BC, V1X 7Y8
'1938 Pandosy Street, Kelowna, BC, V1Y 1R7
'2280 Baron Rd, Kelowna, BC, V1X 7W3
Const key = "YOUR-API-KEY-HERE"
Sub testRun()
Dim orig As String, dest As String, distance_Meters As Long, duration_Sec As Long
orig = EncodeEscapeString("3333 University Way,Kelowna,BC,V1V 1V7")
dest = EncodeEscapeString("1555 Banks Rd, Kelowna, BC, V1X 7Y8")
Call getGoogleDistanceMatrix(orig, dest, distance_Meters, duration_Sec)
Debug.Print distance_Meters & "m"
Debug.Print duration_Sec & "sec"
End Sub
Sub getGoogleDistanceMatrix(ByVal orig As String, ByVal dest As String, ByRef distance_Meters As Long, ByRef duration_Sec As Long)
Const distanceTag1 = """distance"""
Const distanceTag2 = """value"""
Const durationTag1 = """duration"""
Const durationTag2 = """value"""
Dim jSON As String, pStart As Long, pEnd As Long
jSON = Get_URL_text("https://maps.googleapis.com/maps/api/distancematrix/json?units=metric&origins=" & orig & "&destinations=" & dest & "&key=" & key)
pStart = InStr(jSON, distanceTag1) + Len(distanceTag1)
pStart = InStr(pStart, jSON, distanceTag2) + Len(distanceTag2) + 3
pEnd = InStr(pStart, jSON, " ")
distance_Meters = Val(Trim(Mid(jSON, pStart, pEnd - pStart)))
pStart = InStr(jSON, durationTag1) + Len(durationTag1)
pStart = InStr(pStart, jSON, durationTag2) + Len(durationTag2) + 3
pEnd = InStr(pStart, jSON, " ")
duration_Sec = Val(Trim(Mid(jSON, pStart, pEnd - pStart)))
End Sub
Function Get_URL_text(url As String) As String
Dim XMLHTTP As Object
Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.send
Get_URL_text = XMLHTTP.responseText
Set XMLHTTP = Nothing
End Function
Function EncodeEscapeString(str_In As String) As String
Dim s As String
s = str_In
s = Replace(s, "%", "%25")
s = Replace(s, " ", "%20")
s = Replace(s, Chr(34), "%22")
s = Replace(s, "<", "%3C")
s = Replace(s, ">", "%3E")
s = Replace(s, "#", "%23")
s = Replace(s, "|", "%7C")
EncodeEscapeString = s
End Function
This same "cheater method" can be used to to scrape bits of data from any URL (JSON, HTML, XML, CSV, etc) that has a consistent text output.
You may need to add a Tools -> Reference to support XMLHTTP.
Good luck with that! (and don't forget to "accept" this answer if it's at all useful, I already put more time into this than I intended!)
I am trying to export a view using LotusScript. Some of the columns in the view are displaying multi-value field values which display on separate lines within the view. I have made some changes to this code that I imported from the web. I made the change for the separator from commas to pipes "|" because a field in the document may contain commas.
The problem I am having is that I am getting the first line of data to be repeated for the number of entries in the view.
My view looks similar to this:
(For display purposes, I am using commas to separate 3 different items in view)
first column: ReqNum contains
A93120, A93120, A94192
second column: Qty contains
1, 16, 10
third column: Desc contains
tax, APXT918 7" Bolt, 391" sheet metal
The view that I am using is displaying the fields that are needing to be exported. The second and third column are multi-valued fields.
When I export the view, I get the first item repeated 3 times in the file since the view knows that their are 3 entries within the view.
The exported file will look like this:
|ReqNumber|Qty|Desc
|A93120|1|tax
|A93120|1|tax
|A93120|1|tax
Instead of looking like this:
|ReqNumber|Qty|Desc
|A93120|1|tax
|A93120|16|APXT918 7" Bolt
|A94192|10| 391" sheet metal
Can someone tell me where I am missing the piece to move to the next record in the view?
Thank you in advance for your help.... It is very much appreciated.
Jean Stachler
%REM
Agent Copied Export Code
Mar 26, 2015 by Jean Stachler
Description: Comments for Agent
%END REM
Option Public
Option Declare
%Include "lsconst.lss"
%REM
Agent View Export
Created Mar 27, 2013 by Karl-Henry Martinsson
Description: Code to export a specified view as CSV.
Copyright (c) 2013 by Karl-Henry Martinsson
This code is distributed under the terms of
the GNU General Public License V3.
See http://www.gnu.org/licenses/gpl.txt
%END REM
Class RowData
Public column List As String
Public Sub New()
End Sub
Public Sub SetColumnHeader(view As NotesView)
Dim viewcolumn As NotesViewColumn
Dim cnt As Integer
ForAll vc In view.Columns
Set viewcolumn = vc
column(CStr(cnt)) = viewcolumn.Title
cnt = cnt + 1
End ForAll
End Sub
Public Sub SetColumnValues(values As Variant)
Dim cnt As Integer
Dim tmp As String
ForAll v In values
If IsArray(v) Then
ForAll c In v
' tmp = tmp + c + Chr$(13)
tmp = c + Chr$(13)
Messagebox tmp
End ForAll
column(CStr(cnt)) = Left$(tmp,Len(tmp)-1)
Messagebox column(CStr(cnt))
Else
column(CStr(cnt)) = v
Messagebox column(CStr(cnt))
End If
cnt = cnt + 1
End ForAll
End Sub
End Class
Class CSVData
Private row List As RowData
Private rowcnt As Long
%REM
Function New
Description: Open the view and read view data
into a list of RowData objects.
%END REM
Public Sub New(server As String, database As String, viewname As String)
Dim db As NotesDatabase
Dim view As NotesView
Dim col As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim colcnt As Integer
Set db = New NotesDatabase(server, database)
If db Is Nothing Then
MsgBox "Could not open " + database + " on " + server,16,"Error"
Exit Sub
End If
Set view = db.GetView(viewname)
If view Is Nothing Then
MsgBox "Could not access view " + viewname + ".",16,"Error"
Exit Sub
End If
Set col = view.AllEntries()
rowcnt = 0
Set entry = col.GetFirstEntry()
Set row("Header") = New RowData()
Call row("Header").SetColumnHeader(view)
Do Until entry Is Nothing
rowcnt = rowcnt + 1
Set row(CStr(rowcnt)) = New RowData()
Call row(CStr(rowcnt)).SetColumnValues(entry.ColumnValues)
Set entry = col.GetNextEntry(entry)
Loop
End Sub
%REM
Function CSVArray
Description: Returns a string array of CSV data by row
%END REM
Public Function CSVArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
Messagebox h
' textrow = textrow + |"| + Replace(h,Chr$(13),"\n") + |",|
' textrow = textrow + |"| + Replace(h,Chr$(13),"|")
textrow = textrow + "|" + Replace(h,Chr$(13),"|")
Messagebox textrow
End ForAll
Messagebox textrow
rowarray(cnt) = Left$(textrow,Len(textrow)-1)
Messagebox rowarray(cnt)
cnt = cnt + 1
End ForAll
CSVArray = rowarray
End Function
%REM
Function HTMLArray
Description: Returns a string array of HTML data by row
%END REM
Public Function HTMLArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |<td>| + Replace(h,Chr$(13),"<br>") + |</td>|
End ForAll
rowarray(cnt) = "<tr>" + textrow + "</tr>"
cnt = cnt + 1
End ForAll
HTMLArray = rowarray
End Function
End Class
%REM
********************************
Example of how to call the class
********************************
%END REM
Sub Initialize
Dim csv As CSVData
Dim outfile As String
Set csv = New CSVData("CrownNotes2/CrownNotes", "Purchasing\purreqdyn.nsf", "(ExportDetail)")
outfile = "c:\Data\ReqdetailSecond.txt"
Open outfile For Output As #1
ForAll row In csv.CSVArray()
Print #1, row
End ForAll
Close #1
outfile = "c:\Data\ExcelExportTest.xls"
Open outfile For Output As #2
Print #2, "<table>"
ForAll row In csv.HTMLArray()
Print #2, row
End ForAll
Print #2, "</table>"
Close #2
End Sub
I will try again to get the details listed.
Here is the section that will repeat the line the number of times the line is listed. It seems to me that it is picking up the first item, instead of going through the multivalue field.
ForAll r In row
textrow = ""
ForAll h In r.column
Messagebox h
textrow = textrow + "|" + Replace(h,Chr$(13),"|")
Messagebox textrow
End ForAll
Messagebox textrow
rowarray(cnt) = Left$(textrow,Len(textrow)-1)
Messagebox rowarray(cnt)
cnt = cnt + 1
End ForAll
CSVArray = rowarray
I have also come up with another way of doing this but am having a problem trying to get rid of carriage returns. Will post this issue shortly.
I need to export a lotus notes view to excel. The problem is, I have two columns in the view which displays multiple values with "New line" as the separator. I tried the inbuilt export function as well as with a new lotus script export function with few formatting. In both the cases the multiple values cannot be made to appear in one cell. Only the first value is displayed in each row. The rest of the values are ignored. Our User wants the excel report only with Multiple values in New line and not with any other delimiter.
Kindly help me with your suggestions. I am using Lotus notes 6.5 and Microsoft office 2010.
Thank you.
Write the export in Lotusscript. Not hard, and you get full control of the export.
If the fields are multi-value fields, simply read the values as a variant and then write them to the output file with newline between each item.
Here is one idea of how to solve it:
%REM
Agent View Export
Created Mar 27, 2013 by Karl-Henry Martinsson
Description: Code to export a specified view as CSV.
Copyright (c) 2013 by Karl-Henry Martinsson
This code is distributed under the terms of
the GNU General Public License V3.
See http://www.gnu.org/licenses/gpl.txt
%END REM
Option Public
Option Declare
Class RowData
Public column List As String
Public Sub New()
End Sub
Public Sub SetColumnHeader(view As NotesView)
Dim viewcolumn As NotesViewColumn
Dim cnt As Integer
ForAll vc In view.Columns
Set viewcolumn = vc
column(CStr(cnt)) = viewcolumn.Title
cnt = cnt + 1
End Forall
End Sub
Public Sub SetColumnValues(values As Variant)
Dim cnt As Integer
Dim tmp As String
ForAll v In values
If IsArray(v) Then
ForAll c In v
tmp = tmp + c + Chr$(13)
End ForAll
column(CStr(cnt)) = Left$(tmp,Len(tmp)-1)
Else
column(CStr(cnt)) = v
End If
cnt = cnt + 1
End ForAll
End Sub
End Class
Class CSVData
Private row List As RowData
Private rowcnt As Long
%REM
Function New
Description: Open the view and read view data
into a list of RowData objects.
%END REM
Public Sub New(server As String, database As String, viewname As String)
Dim db As NotesDatabase
Dim view As NotesView
Dim col As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim colcnt As Integer
Set db = New NotesDatabase(server, database)
If db Is Nothing Then
MsgBox "Could not open " + database + " on " + server,16,"Error"
Exit Sub
End If
Set view = db.GetView(viewname)
If view Is Nothing Then
MsgBox "Could not access view " + viewname + ".",16,"Error"
Exit Sub
End If
Set col = view.AllEntries()
rowcnt = 0
Set entry = col.GetFirstEntry()
Set row("Header") = New RowData()
Call row("Header").SetColumnHeader(view)
Do Until entry Is Nothing
rowcnt = rowcnt + 1
Set row(CStr(rowcnt)) = New RowData()
Call row(CStr(rowcnt)).SetColumnValues(entry.ColumnValues)
Set entry = col.GetNextEntry(entry)
Loop
End Sub
%REM
Function CSVArray
Description: Returns a string array of CSV data by row
%END REM
Public Function CSVArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |"| + Replace(h,Chr$(13),"\n") + |",|
End ForAll
rowarray(cnt) = Left$(textrow,Len(textrow)-1)
cnt = cnt + 1
End ForAll
CSVArray = rowarray
End Function
%REM
Function HTMLArray
Description: Returns a string array of HTML data by row
%END REM
Public Function HTMLArray() As Variant
Dim rowarray() As String
Dim textrow As String
Dim cnt As Long
ReDim rowarray(rowcnt) As String
ForAll r In row
textrow = ""
ForAll h In r.column
textrow = textrow + |<td>| + Replace(h,Chr$(13),"<br>") + |</td>|
End ForAll
rowarray(cnt) = "<tr>" + textrow + "</tr>"
cnt = cnt + 1
End ForAll
HTMLArray = rowarray
End Function
End Class
%REM
********************************
Example of how to call the class
********************************
%END REM
Sub Initialize
Dim csv As CSVData
Dim outfile As String
Set csv = New CSVData("DominoServer/YourDomain", "names.nsf", "People\By Last Name")
outfile = "c:\ExcelExportTest.csv"
Open outfile For Output As #1
ForAll row In csv.CSVArray()
Print #1, row
End ForAll
Close #1
outfile = "c:\ExcelExportTest.xls"
Open outfile For Output As #2
Print #2, "<table>"
ForAll row In csv.HTMLArray()
Print #2, row
End ForAll
Print #2, "</table>"
Close #2
End Sub
I have a problem with the split function I have currently. I am able to either split with 1 delimited only (split()) or split with many single characters (custom()). Is there a way to split this? Keep in mind that these delimiters are not in order.
"MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS"
I need your help to get the following result
"MY" , "DATA" , "IS" , "LOCATED" , "HERE" , "IN" , "BETWEEN","THE", "ATS" , "AND", "MARKS"
thanks
Create a new VB6 EXE project and add a button to the form you will be given, and use the following code for the Button1_Click event:
Private Sub Command1_Click()
Dim myText As String
Dim myArray() As String
Dim InBetweenAWord As Boolean
Dim tmpString As String
Dim CurrentCount As Integer
CurrentCount = 0
myText = "MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS"
For i = 1 To Len(myText)
If (Mid(myText, i, 1) = "#" Or Mid(myText, i, 1) = "!") And InBetweenAWord = True Then
CurrentCount = CurrentCount + 1
ReDim Preserve myArray(CurrentCount)
myArray(CurrentCount) = tmpString
tmpString = ""
InBetweenAWord = False
Else
If (Mid(myText, i, 1) <> "#" And Mid(myText, i, 1) <> "!") Then
tmpString = tmpString & Mid(myText, i, 1)
InBetweenAWord = True
End If
End If
Next
For i = 1 To CurrentCount
MsgBox myArray(i) 'This will iterate through all of your words
Next
End Sub
Notice that once the first For-Next loop is finished, the [myArray] will contain all of your words without the un-desired characters, so you can use them anywhere you like. I just displayed them as MsgBox to the user to make sure my code worked.
Character handling is really awkward in VB6. I would prefer using built-in functions like this
Private Function MultiSplit(ByVal sText As String, vDelims As Variant) As Variant
Const LNG_PRIVATE As Long = &HE1B6 '-- U+E000 to U+F8FF - Private Use Area (PUA)
Dim vElem As Variant
For Each vElem In vDelims
sText = Replace(sText, vElem, ChrW$(LNG_PRIVATE))
Next
MultiSplit = Split(sText, ChrW$(LNG_PRIVATE))
End Function
Use MultiSplit like this
Private Sub Command1_Click()
Dim vElem As Variant
For Each vElem In MultiSplit("MY!!DATA##IS!!LOCATED##HERE!!IN!!BETWEEN##THE##ATS!!AND!!MARKS", Array("!!", "##"))
Debug.Print vElem
Next
End Sub