I would like to know what I'm doing wrong...
I have a word document open (in word 2010) with three tables in it. I wanted to test basic table extraction in VBA and followed the instructions http://msdn.microsoft.com/en-us/library/office/aa537149(v=office.11).aspx.
Sub ExtractTableData()
Dim doc As Word.Document
Dim tbl As Word.Table
Dim rng As Word.Range
Dim sData As String
Dim aData1() As String
Dim aData2() As String
Dim aDataAll() As String
Dim nrRecs As Long
Dim nrFields As Long
Dim lRecs As Long
Dim lFields As Long
Set doc = ActiveDocument
Set tbl = doc.Tables(1)
Set rng = tbl.ConvertToText(Separator:=vbTab, _
NestedTables:=False)
' Pick up the delimited text into and put it into a string variable.
sData = rng.Text
' Restore the original table.
doc.Undo
' Strip off last paragraph mark.
sData = Mid(sData, 1, Len(sData) - 1)
' Break up each table row into an array element.
aData1() = Split(sData, vbCr)
nrRecs = UBound(aData1())
' The messagebox below is for debugging purposes and tells you
' how many rows are in the table. It is commented out but can
' be used simply by uncommenting it.
'MsgBox "The table contained " & nrRecs + 1 & " rows"
'Process each row to break down the field information
'into another array.
For lRecs = LBound(aData1()) To nrRecs
aData2() = Split(aData1(lRecs), vbTab)
' We need to do this only once!
If lRecs = LBound(aData1()) Then
nrFields = UBound(aData2())
ReDim Preserve aDataAll(nrRecs, nrFields)
End If
' Now bring the row and field information together
' in a single, two-dimensional array.
For lFields = LBound(aData2()) To nrFields
aDataAll(lRecs, lFields) = aData2(j)
Next
Next
End Sub
I'm getting an error at this line: ReDim Preserve aDataAll(nrRecs, nrFields), which is due to "nrFields" being set to a negative value (-1)...
No idea how the upper bound of the array is a negative value... Any help on this would be much appreciated.
I figured it out - I was trying to extract a nested table. I had to cycle through all sub-tables and extract individually. Also, I had to search for and remove ^p before extraction to retain table structure.
After I had figured it out, I noticed that the MS code sample had an error: aData2(j) should actually be aData2(lFields).
Hope this helps some other newbie!
If UBound is -1 and LBound = 0, the array is empty. You can generate an empty array as follows:
Dim EmptyArray() As String
Dim s As String
EmptyArray = Split("")
Debug.Print (UBound(EmptyArray)) ' displays -1
Debug.Print (LBound(EmptyArray)) ' displays 0
In your case I suspect you need to skip the processing if the array is empty:
aData1 = Split(...)
If (UBound(aData1) < LBound(aData1) Then
' UBound is -1 and LBound is 0, array is empty, nothing to do
Else
' Array is non-empty, do your stuff
End If
Although quite bizarre, it is possible for VARIANT SAFEARRAY to have negative lower and upper bound values for any of the dimensions. The array extent is LBound(,dimension) to UBound(,dimension).
What must be true is UBound >= LBound.
To get the array size, use UBound - LBound + 1.
It used to be convention to set the lower bound using an Option Base statement at the top of VBA code although, of course, that didn't affect arrays being returned by 3rd party libraries. Most folk used to use 1 as the lower bound.
Related
I'm currently busy with Excel tooling and learning a lot but i got a question. Currently i have a couple rows with data in the rows. In the rows there is a lot of data but i need a specific part of the row. Of course i can delete it all manually but to do that for 3000 rows i will be wasting a lot of time.
Can any one help me with a macro that filters data. The data i need is between [ and ] so for example [data]
I hope you guys can help me out and if you need more information just ask me! I hope you guys can help me!
Example String ROW:
[Sandwitch]><xsd:element name="T8436283"
So what do i need?
So i need a macro that only gets the Sandwitch out of it and paste it in the B column. The string with all the information stays at column A and the Sandwitch goes to Column B and that for all rows.
Option 1: Find/Replace
1) Copy data in another column (just saving original copy)
2) Perform Find/Replace "*["
3) Perform Find/Replace "]"
Now you have data which was between [].
Option 2: Use formulas
1) Lets assume that original data in Column "A"
2) Apply this formula in column "B" which will extract data between []
=MID(A1,FIND("[",A1)+1,FIND("]",A1)-FIND("[",A1)-1)
Option 3: Macro
If it is absolutely needed, I can help create a macro, otherwise try first two easier options.
A general purpose "find element in s starting x up to next y":
Function GenExtract(FromStr As String, _
StartSep As String, EndSep As String) _
As Variant
Dim StPos As Long
Dim EnPos As Long
GenExtract = CVErr(xlErrNA)
If StartSep = "" Or EndSep = "" Then Exit Function 'fail
StPos = InStr(1, FromStr, Left(StartSep, 1))
If StPos = 0 Or StPos = Len(FromStr) Then Exit Function 'fail
EnPos = InStr(StPos + 1, FromStr, Left(EndSep, 1))
If EnPos = 0 Then Exit Function 'fail
GenExtract = Mid(FromStr, StPos + 1, EnPos - StPos - 1)
End Function
If the two separators are the same, as per quotes, it gives the first string enclosed by those.
If you want to get your feet wet in Regular Expressions, the following code will take you there. You have to add a reference to the VB Scripting Library
Tools > References > Microsoft VBScript Regular Expressions 5.5
Then the code is as follows:
Sub textBetweenStuffs()
Dim str As String
Dim regEx As RegExp
Dim m As Match
Dim sHolder As MatchCollection
Dim bracketCollection As Collection
Dim quoteCollection As Collection
Set regEx = New RegExp
'Matches anything in between an opening bracket and first closing bracket
regEx.Pattern = "\[(.*?\])"
str = "[Sandwitch]><xsd:element name=""T8436283"""
'populates matches into match collection
Set sHolder = regEx.Execute(str)
Set bracketCollection = New Collection
'loop through values in match collection to do with as you wish
For Each m In sHolder
bracketCollection.Add m.Value
Next i
Set sHolder = Nothing
'get values between Quotations
regEx.Pattern = "\"(.*?\")"
'populates matches into match collection
Set sHolder = regEx.Execute(str)
Set quoteCollection = New Collection
'loop through values in match collection to do with as you wish
For Each m In sHolder
quoteCollection.Add m.Value
Next i
End Sub
I am trying to use the page numbers to the right-hand side of a table of contents object in Word in some VBA code. I can access the array storing the text associated with these page numbers using GetCrossReferenceItems(wdRefTypeHeading) but cannot seem to get at the page numbers themselves. None of the GetCrossReferenceItems constants listed here seem relevant.
Is there a way to reference these page numbers? Thanks!
I'm not a "Worder" so here is what I came up to:
Function GetPagesNumber(doc As Document) As Long()
Dim i As Long
Dim myRng As Range
Dim myHeadings As Variant
With doc
Set myRng = .Content
myRng.Collapse Direction:=wdCollapseEnd
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
ReDim pages(1 To UBound(myHeadings)) As Long
For i = 1 To UBound(myHeadings)
myRng.InsertCrossReference ReferenceType:=wdRefTypeHeading, ReferenceKind:=wdPageNumber, ReferenceItem:=i
With .Paragraphs(ActiveDocument.Paragraphs.count).Range
myRng.SetRange Start:=.Start, End:=.End - 1
End With
pages(i) = CLng(myRng.Text)
Next i
End With
myRng.Delete
GetPagesNumber = pages
End Function
to be used like follows:
Option Explicit
Sub main()
Dim myPagesNumber() As Long
myPagesNumber = GetPagesNumber(ActiveDocument) '<-- store index pages numbers in myPagesNumber
End Sub
Instead of using;
myHeadings = .GetCrossReferenceItems(wdRefTypeHeading)
You can also use;
Dim myField As Field
Set myField = ActiveDocument.TablesOfContents(1).Range.Fields(1)
myHeadings = Split(myField.Result.Text, Chr(13))
This will return an array of strings, with within the last characters of the array the page number of the heading. Use pgnr = CInt(Right(myHeadings (i), Len(myHeadings (i)) - InStrRev(myHeadings (i), Chr(9)))) to get the pagenumber.
What would be better is to first split myHeadings into rows with Chr(13) as delimiter and then split into columns with Chr(9) as delimiter.
So the whole table of contents in an array.
I have a worksheet that contains information on projects. The worksheet contains a column which contains risks for each project. There is a one-to-many relationship between a project and its risks.
Currently the risks for a projects are added to single cell and separated by a line break. I need to add sequential identifiers at the start of each risk. So for example inside a particular cell it should look like this. The sequential number should be bold if at all possible.
1).**Risk 1
2).**Risk 2
3).**Risk 3
etc.
Any suggestions on how to tackle this would be appreciated.
Here's how I'd approach it via UDF:
' Reformats a list from a simple delimitation to a numbered list
' Accepts arrays of strings for inList (allowing array formulas)
' numFormat is a standard Excel-style format string (default "0. ")
' inDelimiter is the delimiter in the input list
' outDelimiter is the delimiter for the output list
Public Function TO_NUMBERED_LIST(inList As Variant, Optional numFormat As Variant, _
Optional inDelimiter As Variant, Optional outDelimiter As Variant) As Variant
Dim i As Integer, j As Integer
' Set default parameters
If IsMissing(numFormat) Then numFormat = "0). "
If IsMissing(inDelimiter) Then inDelimiter = vbNewLine
If IsMissing(outDelimiter) Then outDelimiter = inDelimiter
If IsArray(inList) Then ' Must loop through each entry if using as an array formula
Dim outList() As Variant
ReDim outList(0 To (UBound(inList) - LBound(inList)), 1 To 1)
j = 0
For i = LBound(inList) To UBound(inList)
If IsError(inList(i, 1)) Then
outList(j, 1) = inList(i, 1)
Else
outList(j, 1) = MakeNumbered(CStr(inList(i, 1)), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
j = j + 1
Next
TO_NUMBERED_LIST = outList
Else
TO_NUMBERED_LIST = MakeNumbered(CStr(inList), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
End Function
' Helper function to do the actual work of splitting lists, numbering them, and recombining them
Private Function MakeNumbered(inList As String, Optional numFormat As String, _
Optional inDelimiter As String, Optional outDelimiter As String) As String
Dim i As Integer
Dim tokenArr() As String
tokenArr = Split(inList, inDelimiter)
For i = 0 To UBound(tokenArr)
tokenArr(i) = Format(i + 1, numFormat) & tokenArr(i)
Next
MakeNumbered = Join(tokenArr, outDelimiter)
End Function
I leverage some knowledge from your previous thread, like the fact that the input might be an array (and the whole function might be used in an array formula) but will only ever be 1-dimensional.
I've made this pretty general for reformatting. It can take in lists with any input delimiter (in your case, a newline) and output using any desired delimiter (in your case, still a newline). The numFormat parameter acts using the Format function and supports formats like you would commonly see in Excel. Check the documentation if you need help there.
Default parameters have already been tweaked for your example - newline as delimiter(s) and "0). " as numbering format.
You can use the Split function on each cell value to create an array of risks and then prefix each risk with the sequence id. Then you can use the Join function to put the array back into a single value to update the cell with.
Depending on how the newlines got into the cell you might need to use vbCrLf, or vbNewLine instead of vbLf in the following example code:
Option Explicit
Sub AddRiskSequence()
Dim rngRisks As Range
Dim rngCell As Range
Dim varRisks As Variant
Dim lngIndex As Long
'set range with risk values
Set rngRisks = Sheet2.Range("B2:B4")
'iterate cells in risk column
For Each rngCell In rngRisks
'split cell contents by line feed into array
varRisks = VBA.Split(rngCell.Value, vbLf)
'iterate array and add sequence ids
For lngIndex = 0 To UBound(varRisks)
varRisks(lngIndex) = VBA.CStr(lngIndex + 1) & ") " & varRisks(lngIndex)
Next lngIndex
'rejoin array and update cell value
rngCell.Value = VBA.Join(varRisks, vbLf)
Next rngCell
End Sub
Before:
After:
I'm writing a macro to read the below Email:
Start Date: July-07-2016
Name Accept Approved
John Yes No
Peter No No
I'm good with search the word "Start date" and get the next 13 character to copy and paste that in a text file. But my problem is the next part is in a Table format. So when I'm searching for the name "John" and trying to copy the next 10 Characters. It doesn't work.
Is there a way to search for the word "Accept" and get the First Row data(Which will be No) and then Second Row data(Which will be No)? Is that possible?
This EMail's table will have only 2 Rows. So, I don't need any dynamic way to get the data. Can someone guide me?
I've tried searching the internet first, but the solutions are too huge for me to understand. Is there any simple way?
I have even tried the solution give here: How to read table pasted in outlook message body using vba? but that method works when the body has ONLY TABLE. But my EMail will have text as well as table.
I've never actually programmed in vba, but I think I can help (a bit) nevertheless.
In the answer on the post you linked to, there is the line
Set msg = ActiveExplorer.Selection.item(1)
I think you can change this to something like
Set msg = Right(ActiveExplorer.Selection.item(1), 25)
to get rid of the text before the table (I got the Right part from here: http://www.exceltrick.com/formulas_macros/vba-substring-function/, but it should also work in Outlook).
This way, you run the code on the table itself instead of on the whole message.If there is also text after the table, it might be more difficult, but you might get that done by searching for the table ending.
I hope this helps!
Attempt 2
After some searching and thinking, I came up with the idea to get the html of the message and use that to parse the table (Ok, not really, I got it from the comments here: http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus). Based on that and other sources, it is possible to write a code that gets the table from an email.
I've written some code that might work, but I couldn't test it as I do not have Outlook. Also, this is my first time writing vba, so there may be a lot of syntax errors (and the code is ugly).
Sub GetTable()
Dim msg As Outlook.mailItem
Dim html As String
Dim tableBegin As String
Dim tableEnd As String
Dim posTableBegin As Long
Dim posTableEnd As Long
Dim table As String
Dim rowBegin As String
Dim rowEnd As String
Dim rowCount As Long
Dim columnBegin As String
Dim columnBeginLen As Long
Dim columnEnd As String
Dim posRowBegin As Long
Dim posRowEnd As Long
Dim values As String(0, 3)
Dim beginValue0 As Long
Dim beginValue1 As Long
Dim beginValue2 As Long
Dim EndValue0 As Long
Dim EndValue1 As Long
Dim EndValue2 As Long
' Get the message and the html
Set msg = ActiveExplorer.Selection.item(1)
html = msg.HTMLbody
' Get the begin and end positions of the table (within the html)
tableBegin = "<table>"
tableEnd = "</table>"
posTableBegin = InStr(1, html, tableBegin)
posTableEnd = InStr(posTableBegin, html, tableEnd)
' Get the html table
table = Mid(html, posTableBegin + Len(tableBegin), posTableEnd - posTableBegin - Len(tableBegin))
' Set the variables for the loop
rowBegin = "<tr>"
rowEnd = "</tr>"
rowCount = 0
columnBegin = "<td>"
columnBeginLen = Len(columnBegin)
columnEnd = "</td>"
' Loop trough all rows
posRowBegin = InStr(lastPos, table, rowBegin)
Do While posRowBegin != 0
' Get the end from the current row
posRowEnd = InStr(posRowBegin, table, rowEnd)
rowCount = rowCount + 1
' Make the array larger
ReDim Preserve values(rowCount + 1, 3)
' Get the contents from that row
row = Mid(table, posRowBegin + Len(rowBegin), posRowEnd - posRowBegin - Len(rowBegin))
' Get the three values from that row (name, Accept, Approved) and put it in the array
beginValue0 = InStr(1, row, columnBegin) + columnBeginLen
endValue0 = InStr(beginValue0, row, columnEnd)
beginValue1 = InStr(endValue0, row, columnBegin) + columnBeginLen
endValue1 = InStr(beginValue1, row, columnEnd)
beginValue2 = InStr(endValue1, row, columnBegin) + columnBeginLen
endValue2 = InStr(beginValue2, row, columnEnd)
values(rowCount, 0) = Mid(row, beginValue0, endValue0)
values(rowCount, 1) = Mid(row, beginValue1, endValue1)
values(rowCount, 2) = Mid(row, beginValue2, endValue2)
' Get the beginning of the next row
posRowBegin = InStr(lastPos, table, rowBegin)
Loop
' The values are now in the (double) array 'values'.
' values(0, [1-3]) contains the headers.
End Sub
As said before, the original idea came from http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus. Additionally, I used Word VBA how to select text between two substrings and assign to variable? and the Microsoft documentation to write this.
While it is likely that the code does not work out of the box, I think it still gets the general idea (and some specifics) across, so that it can be used as a guide. I hope this is the solution you need!
You can actually use the Word Object Model to parse out the text from the table - assuming that the email is in HTML format.
Get a Word.Document object from the Inspector.WordEditor property and use Word objects and methods to get the text, like the following below example from MSDN. Just replace ActiveDocument with the variable you declare and set from WordEditor.
Sub ReturnCellContentsToArray()
Dim intCells As Integer
Dim celTable As Cell
Dim strCells() As String
Dim intCount As Integer
Dim rngText As Range
If ActiveDocument.Tables.Count >= 1 Then
With ActiveDocument.Tables(1).Range
intCells = .Cells.Count
ReDim strCells(intCells)
intCount = 1
For Each celTable In .Cells
Set rngText = celTable.Range
rngText.MoveEnd Unit:=wdCharacter, Count:=-1
strCells(intCount) = rngText
intCount = intCount + 1
Next celTable
End With
End If
End Sub
before I start I want to point out that I tagged this question as VBA because I can't actually make a new tag for Winwrap and I've been told that Winwrap is pretty much the same as VBA.
I'm working on SPSS V19.0 and I'm trying to make a code that will help me identify and assign value labels to all values that don't have a label in the specified variable (or all variables).
The pseudo code below is for the version where it's a single variable (perhaps inputted by a text box or maybe sent via a custom dialogue in the SPSS Stats program (call the .sbs file from the syntax giving it the variable name).
Here is the Pseudo Code:
Sub Main(variable As String)
On Error GoTo bye
'Variable Declaration:
Dim i As Integer, intCount As Integer
Dim strValName As String, strVar As String, strCom As String
Dim varLabels As Variant 'This should be an array of all the value labels in the selected record
Dim objSpssApp As 'No idea what to put here, but I want to select the spss main window.
'Original Idea was to use two loops
'The first loop would fill an array with the value lables and use the index as the value and
'The second loop would check to see which values already had labels and then
'Would ask the user for a value label to apply to each value that didn't.
'loop 1
'For i = 0 To -1
'current = GetObject(variable.valuelist(i)) 'would use this to get the value
'Set varLabels(i) = current
'Next
'Loop for each number in the Value list.
strValName = InputBox("Please specify the variable.")
'Loop for each number in the Value list.
For i = 0 To varLabels-1
If IsEmpty (varLabels(i)) Then
'Find value and ask for the current value label
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
'Apply the response to the required number
strCom = "ADD VALUE LABELS " & strVar & Chr$(39) & intCount & Chr$(39) & Chr$(39) & strValName & Chr$(39) &" ."
'Then the piece of code to execute the Syntax
objSpssApp.ExecuteCommands(strCom, False)
End If
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
Next
Bye:
End Sub
This is in no way functioning code, it's just basically pseudo code for the process that I want to achieve I'm just looking for some help on it, if you could that would be magic.
Many thanks in advance
Mav
Winwrap and VBA are almost identical with differences that you can find in this post:
http://www.winwrap.com/web/basic/reference/?p=doc_tn0143_technote.htm
I haven't used winwrap, but I'll try to answer with my knowledge from VBA.
Dim varLabels As Variant
You can make an array out of this by saying for example
dim varLabels() as variant 'Dynamically declared array
dim varLabels(10) as variant 'Statically declared array
dim varLabels(1 to 10) as variant 'Array starting from 1 - which I mostly use
dim varLabels(1 to 10, 1 to 3) 'Multidimensional array
Dim objSpssApp As ?
"In theory", you can leave this as a variant type or even do
Dim objSpssApp
Without further declaration, which is basically the same - and it will work because a variant can be anything and will not generate an error. It is good custom though to declare you objects according to an explicit datatype in because the variant type is expensive in terms of memory. You should actually find out about the objects class name, but I cannot give you this. I guess that you should do something like:
set objSpssApp = new <Spss Window>
set objSpssApp = nothing 'In the end to release the object
Code:
'loop 1
For i = 0 To -1
current = GetObject(variable.valuelist(i)) 'would use this to get the value
Set varLabels(i) = current
Next
I don't exactly know why you want to count from 0 to -1 but perhaps it is irrelevant.
To fill an array, you can just do: varLabels(i) = i
The SET statement is used to set objects and you don't need to create an object to create an array. Also note that you did not declare half of the variables used here.
Code:
strVar = InputBox("Please insert Label for value "; varLabels(i);" :","Insert Value Label")
Note that the concatenation operator syntax is &.
This appears to be the same in WinWrap:
http://www.winwrap.com/web/basic/language/?p=doc_operators_oper.htm
But you know this, since you use it in your code.
Code:
'intCount = intCount + 1 'increase the count so that it shows the correct number
'it's out of the loop so that even filled value labels are counted
'Perhaps this method would be better?
I'm not sure if I understand this question, but in theory all loops are valid in any situation, it depends on your preference. For ... Next, Do ... Loop, While ... Wend, in the end they all do basically the same thing. intCount = intCount + 1 seems valid when using it in a loop.
Using Next (for ... next)
When using a counter, always use Next iCounter because it increments the counter.
I hope this reply may be of some use to you!