VBA - trying to create XML based on multiple ranges - excel

I am trying to create an output as a XML (save as text file + ".xml").
The layout of the XML is:
<file-info> (forsendelse)
<record-info>
..account#..
</record-info>
</file-info>
I have created a range of fields where the XML is written so that I can just "copy" from the spreadsheet into the text file.
I have tried the following:
With Worksheets("XML_generator")
Set forsendelse1 = .Range("G10:G31")
dat = forsendelse1.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange1 = .Range("G32:G40")
dat = myrange1.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange_acc = .Range("G41:G41")
dat = myrange_acc.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set myrange2 = .Range("G42:G73")
dat = myrange2.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set forsendelse2 = .Range("G74:G75")
dat = forsendelse2.Value
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(FPath & "Request_" & FName & "_" & FDate & ".xml", True)
End With
When I do this I only get the last range ("forsendelse2") in my XML. Does anyone have an idea on how to get this to work?
Please note:
"..account#.." is just one cell in the workbook. This is the main
data to change between exports.
Not using the built in XML generator, since I require blank tags to be exported as well due to validation
Splitting into 5 is so that I going forward can add more than one "record1 + ..account#.. + record2"
In the future I wish the result to look something like this:
<file-info> (forsendelse)
<record-info>
..account#.. (i.e "A2" from sheet)
</record-info>
<record-info>
..account#.. (i.e "A3" from sheet)
</record-info>
</file-info>
But since I haven't tried to do the "while loop" on this yet, firstly I hope someone can help me fix my Range issue :)
Thank you for taking your time!
Best regards
Andreas Petersen

If you want to build up a string from multiple parts then you need to append each part, like this:
dat = "stack"
dat = dat & "overflow"
dat = dat & ".com"
The value of dat will now be "stackoverflow.com".
Your code is overwriting the existing value rather than appending to it:
dat = "stack"
dat = "overflow"
dat = ".com"
The value of dat will now be ".com"
Other issues:
it's not clear why you are creating multiple FileSystemObjects that don't get used (only the last one gets used for anything)
it may be easier to use MSXML2 and build a DOMDocument rather than trying to create the XML as a string

Related

Wildcards/patterns with .Tables("PARA") when executing RFC INST_EXECUTE_REPORT

I'm using Excel and VBA to get SAP to download data from SAP through RFC using INST_EXECUTE_REPORT.
It works like a charm when I have specific input parameters. I just build up .Tables("PARA") with the screen name of the parameter and the desired value. I can even use this method for date ranges.
The challenge is when I don't know exactly the input parameters. For example, I wanted to identify all internal orders with a specific text in the description, e.g. CODE40.
Is there any way to use wildcards with INST_EXECUTE_REPORT? When the program passed into INST_EXECUTE_REPORT is executed normally as a transaction on screen, I can set the parameter to *CODE40* and SAP automatically applies a wildcard search. But I can't get that to work with VBA.
I can simulate using wildcards when accessing individual tables with BBP_RFC_READ_TABLE by using LIKE statements in the selection option, but I need a similar functionality for whole reports, not individual tables.
Can anyone help?
Best regards,
The code I'm using is as follows:
Set ObjR3_EXECUTE_REPORT = ObjR3.Add("INST_EXECUTE_REPORT")
With ObjR3_EXECUTE_REPORT
Set ObjR3_EXECUTE_REPORT_Name = .Exports("PROGRAM")
Set ObjR3_EXECUTE_REPORT_Para = .Tables("PARA")
Set ObjR3_EXECUTE_REPORT_Result = .Tables("RESULT_TAB")
Set ObjR3_EXECUTE_REPORT_Output = .Tables("OUTPUT_TAB")
End With
ObjR3_EXECUTE_REPORT_Name.Value = ReportName
'Build up the table with the fields to be selected
f = 1
For a = LBound(aParameters) To UBound(aParameters)
aParameterPair = aParameters(a)
aParameterInput = aParameterPair(UBound(aParameterPair))
sParameterName = aParameterPair(LBound(aParameterPair))
For c = LBound(aParameterInput) To UBound(aParameterInput)
sParameterInput = aParameterInput(c)
ObjR3_EXECUTE_REPORT_Para.AppendRow
ObjR3_EXECUTE_REPORT_Para(f, "PARA_NAME") = sParameterName
ObjR3_EXECUTE_REPORT_Para(f, "PARA_VALUE") = sParameterInput
Debug.Print sParameterName & " " & sParameterInput
f = f + 1
Next c
Next a

How to export text from annotation fields in Nuance Power PDF to Excel using VBA?

I am trying to export some text from annotation fields in Nuance Power PDF to Excel using VBA. I added the Nuance Power PDF reference to Excel VBA (PDF Plus).
I used it and it works well but the text returned from fields is empty.
Set PDFApp = CreateObject("NuancePDF.App")
Set dvDoc = CreateObject("NuancePDF.DVDoc")
dvDoc.Open("\\adpdc-2\Users$\a.goudinoux\Documents\Macro Formulaire\fiche.pdf")
Set ddDoc = dvDoc.GetDDDoc()
Set ddPage = ddDoc.AcquirePage(0)
nbannots = ddPage.GetNumAnnots() - 1
For i = 0 To nbannots
Texte = ""
Set ddAnnot = ddPage.GetAnnot(i)
Set ddText = ddDoc.CreateTextSelect(0, ddAnnot.GetRect())
ThisWorkbook.Sheets(1).Cells(1, i) = ddAnnot.GetTitle()
For k = 0 To ddText.GetNumText()
Texte = Texte & ddText.GetText(k)
Next
ThisWorkbook.Sheets(1).Cells(2, i) = Texte
Next
Part of the PDF document :
Results :
As you can see the first line is working but not the second one.
I thought the problem was with ddText but ddText.GetNumText() gives the right number of text elements in the text selection (ex : 2, 5, 4, etc...) when I run my program in Debug Mode.
I think the problem is from the function GetText(k).
I made it work once but I can't find my code back..
Do you see any mistake ?
Either your annotations are more complex than indicated or you're overthinking it.
Just read the annotation with GetContents and call it a day.
Set PDFApp = CreateObject("NuancePDF.App")
Set dvDoc = CreateObject("NuancePDF.DVDoc")
dvDoc.Open("\\adpdc-2\Users$\a.goudinoux\Documents\Macro Formulaire\fiche.pdf")
Set ddDoc = dvDoc.GetDDDoc()
Set ddPage = ddDoc.AcquirePage(0)
nbannots = ddPage.GetNumAnnots() - 1
For i = 0 To nbannots
Set ddAnnot = ddPage.GetAnnot(i)
ThisWorkbook.Sheets(1).Cells(1, i) = ddAnnot.GetTitle
ThisWorkbook.Sheets(1).Cells(2, i) = ddAnnot.GetContents
Next i

Excel VBA - Get chart data range

I want to add data to a bunch of existing charts. Assume that each chart has a different number of data series and that the location of the raw data is somewhere in the same workbook. Here's what I'm starting with:
For iChart = 1 To iCount
ActiveSheet.ChartObjects("Chart " & iChart).Activate
intSeries = 1
Do Until ActiveChart.SeriesCollection(intSeries).Name = ""
Set rXVal = ActiveChart.SeriesCollection(intSeries).XValues '<- Object Required error
Set rXVal = Range(rXVal, rXVal.End(xlDown))
Set rYVal = ActiveChart.SeriesCollection(intSeries).Values
Set rYVal = Range(rYVal, rYVal.End(xlDown))
ActiveChart.SeriesCollection(intSeries).XValues = rXVal
ActiveChart.SeriesCollection(intSeries).Values = rYVal
intSeries = intSeries + 1
Loop
Next iChart
I know that ActiveChart...XValues = rXVal works, but I'm getting an "Object Required" error on the Set rXVal = ActiveChart....XValues line. I'm assuming that since a range went in to define the data series, I can get that range back out again and then add to it.
UPDATE
To clarify things a little, I have accelerometers in 8 places and FFT software setup to record peak vibration response in 4 separate frequency bands. This yields 32 data points per sample. When exporting, the software spits out an Excel workbook with 4 sheets; one for each frequency band. Each sheet has the accelerometer names going across and sample numbers going down.
I have succeeded using this syntax:
Dim rXVal() As Variant
rXVal = ActiveChart.SeriesCollection(intSeries).XValues
UPDATE
In this case you get an array, because your given statement (ActiveChart.SeriesCollection(intSeries).XValues) is an array and not a range. This is what you see in Locals window if you dig into Series object of ActiveChart.SeriesCollection(intSeries):
(in my dummy data I have rows named r1, r2, r3, r4.)
What I want to say, XValues does not have any property which would indicate its occupied range.
If you actually need a range, I would suggest getting it from the formula property. And the way I would suggest is replacing your error causing line with this one:
Set rXVal = Range(Split(ActiveChart.SeriesCollection(intSeries).Formula, ",")(1))
Next, I see you trying to get the range for Values. Similarly, use this:
Set rYVal = Range(Split(ActiveChart.SeriesCollection(intSeries).Formula, ",")(2))
Another thing.
The following lines will cause you an error finally:
intSeries = 1
Do Until ActiveChart.SeriesCollection(intSeries).Name = ""
...some code...
intSeries = intSeries + 1
Loop
Do change them with:
For intSeries = 1 To ActiveChart.SeriesCollection.Count
...some code...
Next
Yet another thing.
Consider using With and End With, as you repeat a lot ActiveChart.SeriesCollection(intSeries). Then your code will be much more readable, as you would just skip this long line! Wouldn't that be awesome???
This works fine for me:
Dim rXVal() As Variant
Dim rXValMin, rXValMax As Double
rXVal = ActiveChart.SeriesCollection(intSeries).XValues
rXValMin = WorksheetFunction.Min(rXVal)
rXValMax = WorksheetFunction.Max(rXVal)

Determine Image in Excel Comment

I have found plenty of vba for inserting images into a comment
Selection.ShapeRange.Fill.UserPicture "C:\Temp\Pictures\ewe.jpg"
How can you determine the image already used for an comment?
I would like to extract the embedded image names if possible.
Is there not a property to access that will give me this?
In the comment Fill Effects dialog box the image name somehow seems to be accessible.
Sorry, I didn't have the reputation to just comment on your question for clarification.
I made a test file, inserted a comment and image in that comment, and then extracted the base files. I then checked them all for the original file name. I also found the embedded JPEG and decoded it to get the metadata. As you've noted, the original file names are stored in xl\drawings\vmlDrawing1.vml (once you've extracted the xml files from the excel file by appending .zip to the filename and then running an unzip utility on it). I did find the file name, but not the path or file type, so I'm fairly certain that the path and file type aren't preserved.
If just the file name is sufficient for you, then that file contains information for each drawing that you have, and those will include the cell location, although they're 0 based, so you'd have to add one to get the actual row and column. My question is two part:
1) Is the file name alone sufficient, or did you need the entire path? If you needed the entire path, I think you're out of luck, since the paths are on a different computer and you can't even search for them if you do extract the file name.
2) If that is all you need, does the solution have to be VBA? In the past, I have programmatically unzipped and manipulated the xml base files, but it's a little tricky. It's simplified by the fact that you only have to read out the data, so that's a plus. I did it in .net before, but I'm sure that if it had to be VBA it could be done, but it would be simpler if you were open to the type of solution.
Let me know, I'd be happy to help you out.
====================================================================================
Try this: make a copy of the spreadsheet, append .zip (test.xlsm.zip), and then extract the files manually. Change vmlPath to the location of your xl\drawings\vmlDrawing1.vml file. Then run this. I did make some assumptions, for instance, I assumed that the order of the nodes and attributes would always be the same and so I used hardcoded indexes (shp.attributes(0), etc) instead of using logic to make sure I had the correct node or attribute, but you seem like you know your way around VBA, so I'm just going to code a barebones. This will need a reference to Microsoft XML 6.0.
Sub vmlParse()
Dim vmlPath As String: vmlPath = "C:\Users\Lenovo\Desktop\test - Copy.xlsm\xl\drawings\vmlDrawing1.vml"
Dim this As Worksheet: Set this = ActiveSheet
Dim doc As New DOMDocument, shps As IXMLDOMNodeList
Dim shp As IXMLDOMNode, n As IXMLDOMNode, a As IXMLDOMAttribute
Dim fileName As String, productID As String
Dim rng As Range, r As Long, c As Long
doc.Load vmlPath
Set shps = doc.getElementsByTagName("x:ClientData")
For Each shp In shps
If shp.Attributes(0).nodeValue = "Note" Then
r = 0: c = 0
For Each a In shp.ParentNode.FirstChild.Attributes
If a.nodeName = "o:title" Then
fileName = a.nodeValue
Exit For
End If
Next
For Each n In shp.childNodes
If n.nodeName = "x:Row" Then r = n.text
If n.nodeName = "x:Column" Then c = n.text
Next
Set rng = this.Cells(r + 1, c + 1)
productID = rng.Value
'now you have the productID, the fileName, and the cell location
End If
Next
End Sub
Let me know how that worked out for you.
If c4 contains your comment:
Set shp = Range("C4").Comment.Shape
if shp.Fill.TextureType = msoTextureUserDefined then
end if

How to change the alterrowcolor and Header Style using Lotus script?

My requirement is, I am having a hundreds of views. I want to make them as standard colors and UI. Simple I am using for changing the font color for column header and column values by NotesViewColumn class. But I do not know that which class is having the property for action bar and View alternate color and Heaer style and etc.,
In javascript is also welcome., But it should change its property as a designer level.
Thanks in advance
You have 3 options:
The easiest one: Go and buy ezView from Ytria. Should take you less than an hour to sort your views out
Create one view that looks the way you want your views to look and then go through all the views in a script, rename them, create a new view based on your view template and copy the view columns from the old views and adjust the view selection formulas (all in LotusScript)
Export your views in DXL and run some XSLT or search/replace to adjust the properties
Hope that helps
I just ran this agent, to change all the views in my (small) test database to having alternate row colours, and it worked.
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim exporter As NotesDXLExporter
Dim importer As NotesDXLImporter
Dim out As String
Dim infile As string
Dim pointer As long
Dim filenum As Integer
Dim altrow As integer
Dim unid As String
Dim doc As notesdocument
Set db = session.currentdatabase
Set exporter = session.Createdxlexporter
Set importer = session.Createdxlimporter
Dim count As Integer
count = 1
ForAll v In db.views
unid = v.UniversalID
Set doc = db.getdocumentbyunid(unid)
out = exporter.Export(doc)
altrow = instr(out, "altrowcolor")
If altrow > 0 Then
pointer = InStr(altrow, out, "=")
out = Left(out,pointer) & "'#f7f7f7'" & Mid(out, pointer+10)
else
pointer = InStr(out, "bgcolor=")
pointer = InStr(pointer, out, " ")
out = Left(out,pointer) & "altrowcolor='#f7f7f7' " & Mid(out, pointer+1)
End if
Call importer.setinput(out)
Call importer.setoutput(db)
importer.Designimportoption = 5
importer.Documentimportoption = 5
Call importer.Process()
out = ""
infile = ""
count = count + 1
End ForAll
Print count & " views processed"
End Sub
If your view designs are much bigger, you might want to use a NotesStream instead of String for "out". In that case, from the Help Files, I believe that the stream has to be closed and re-opened before you can use it for import.
For further research, I suggest writing "out" to a file, and examining the xml to find other "hidden" parameters.
Have fun, Phil
I can also recommend ezView. Makes it a piece of cake to modify views. I also use actionBarEZ to modify action bars across applications.
I blogged about a few different development tools I use in Domino Designer, you can find the entry here: http://www.bleedyellow.com/blogs/texasswede/entry/mydevelopmenttools

Resources