I have created a small application in Excel-VBA which takes inputs from a user and the application sends and email to me the inputs in an encrypted form.
Now, I have a macro in outlook-vba which takes care of decryption and saves data in required format, so that's not a problem. What I need is I want to open that specific mail from the user in a customized format so that without running that script I could see the data.
E.g. The data comes in like this
1~Saurav Gupta~100^2~Sachin Rana~200^
Now I want it to be shown as in a tabular format in a form, say
S.No Name Marks
1 Saurav Gupta 100
2 Sachin Rana 200
Any idea how can I achieve that?
Thanks and regards
Saurav.
Use the builtin Split function to separate the lines and the fields in the data:
Option Explicit
Sub SplitTest()
Dim sInput As String
Dim sLines() As String
Dim sFields() As String
Dim iLine As Integer
sInput = "1~Saurav Gupta~100^2~Sachin Rana~200^"
'***** Split sInput into lines
sLines = Split(sInput, "^")
'***** Do something with the lines
For iLine = 0 To UBound(sLines) - 1
Debug.Print sLines(iLine)
'***** Split each line into fields
sFields = Split(sLines(iLine), "~")
'***** Do something with the fields
Debug.Print "#1. " & sFields(0) & ", #2. " & sFields(1) & ", #3. " & sFields(2)
Next iLine
End Sub
Related
I have a big table in ms-word that contains 85 contentcontrols (combo boxes). I want to change the content using a vba loop (see below). It takes longer than one minute for it to complete...
Are there other options?
Private Sub Btn_Clear1_Click()
Dim a
Dim c As ContentControl
a = FindTable(ActiveDocument.Name, "myTableName")(1) 'returns an array(Long) with number of table found
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
End Sub
Thanks in advance for any hint!
Here, turning off screenupdating reduces the time from about 6 seconds to less than 1 second. e.g.
On Error Goto turnscreenon
Application.Screenupdating = False
For Each c In ActiveDocument.Tables(a).Range.ContentControls
c.Range.text = "MY CHANGED TEXT"
Next c
turnscreenon:
Application.Screenupdating = True
That may only work on the Windows version of Word.
If you know exactly how many combo boxes there are going to be, you could consider creating a custom xml part containing an array of XML Elements to contain the values. Map each content control to one of those elements. Then instead of writing the values to the content control ranges, write them to the XML Part and let Word do the work. That works almost instantaneously here.
e.g. in a simple scenario where you just have those 85 content controls in the table, you could set up the Custom XML Part like this (I leave you to write any code that you need to delete old versions). You should only need to run this once.
Sub createCxpAndLink()
' You should choose your own Uri
Const myNamespaceUri As String = "mycbcs"
Dim a
Dim i As Long
Dim s As String
Dim cxp As Office.CustomXMLPart
With ActiveDocument
a = FindTable(.Name, "myTableName")(1)
s = ""
s = s & "<?xml version='1.0' encoding='UTF-8'?>" & vbCrLf
s = s & "<cbcs xmlns='" & myNamespaceUri & "'>" & vbCrLf
For i = 1 To .Tables(a).Range.ContentControls.Count
s = s & " <cbc/>" & vbCrLf
Next
s = s & "</cbcs>"
Set cxp = .CustomXMLParts.Add(s)
With .Tables(a).Range.ContentControls
For i = 1 To .Count
.Item(i).XMLMapping.SetMapping "/x:cbcs[1]/x:cbc[" & Trim(CStr(i)) & "]", "xmlns:x='" & myNamespaceUri & "'", cxp
Next
End With
Set cxp = Nothing
End With
End Sub
Then to update the contents you need something like this
Sub testsetxml()
Const myNamespaceUri As String = "mycbcs"
Dim i As Long
'our start time...
Debug.Print Now
With ActiveDocument.CustomXMLParts.SelectByNamespace(myNamespaceUri)(1)
For i = 1 To 85
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text "
' or if you want to put different texts in different controls, you can test using e.g.
.SelectNodes("/ns0:cbcs[1]/ns0:cbc[" & Trim(CStr(i)) & "]")(1).Text = "my changed text " & Cstr(i)
Next
End With
'our end time...
Debug.Print Now
End Sub
(NB you cannot do it by mapping all the controls to a single XML element because then all the dropdowns will all be updated to the same value whenever you change the value of one of them.)
Apologies for any typos - I've changed the code to be more in line with what you have already and have not tested the changes.
I have been tasked with creating and updating a series of VBA based excel add-on programs by my superiors at work. One of the programs is a utility that compares the contents of two folders and gives a list of what files are different. Most of the program works very well, but I am having issues with one section of the code; namely, the section that is tasked with gathering all the filenames of the files to be checked.
The section itself does function, most of the time with no issue, but on occasion, it will take inordinate amounts of time. I have been running the tests on the same set of data for the entire development of the utility, so I know that the issue is not the number of files being searched (which is in the hundreds and will eventually be nearly the thousands). My issue is that the section of code is wildly inconsistent with its timing.
The section of code in question is here:
Sub GetFileList(ByRef FileSpec() As String, FileArray() As FileInfo, FoldIndex As Integer)
'FileSpec - an array of strings that correspond to the filtered list of file extensions to be searched
'FileArray - an array of strings that will end up holding the complete list of relevant file names
'FoldIndex - an integer that corresponds to which folder is being searched (1 or 2)
'Returns an array of filenames that match FileSpec
'If no matching files are found, returns an error messagebox
'Arbitrarly takes inordinate amount of time, sometimes upwards of 20 seconds, to finish running.
'Usually when the filtering has been changed.
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
For i = LBound(FileSpec) + 1 To UBound(FileSpec)
FileName = Dir(FileSpec(i))
'Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount).FileName = FileName
FileName = Dir()
Select Case FoldIndex
Case 1
Call FormFunctionality.UpdateResults(FileCount & ": " & FileArray(FileCount).FileName & vbCrLf, "")
Case 2
Call FormFunctionality.UpdateResults("", FileCount & ": " & FileArray(FileCount).FileName & vbCrLf)
End Select
Loop
Next i
If FileCount = 0 Then GoTo NoFilesFound
Exit Sub
'Error handler
NoFilesFound:
ReDim FileArray(1)
FileArray(1).FileName = "Error"
MsgBox ("Error: No files found of requested type" & vbCrLf & "Please review folders and requested file types.")
End
End Sub
Sub UpdateResults(Str1 As String, Str2 As String)
'Prints strings to the results window text boxes
RbtUtilResultScreen.Folder1Results.Text = RbtUtilResultScreen.Folder1Results.Text & Str1
RbtUtilResultScreen.Folder2Results.Text = RbtUtilResultScreen.Folder2Results.Text & Str2
RbtUtilResultScreen.Folder1Results.SetFocus
RbtUtilResultScreen.Folder2Results.SetFocus
End Sub
The Time inconsistency varies wildly. For ~350 files being searched, the average time to generate the list of files is about 2 seconds. Sometimes, that time shoots up to 10 or 20 seconds, which is frankly unacceptable. It gets even worse with more files being searched, and I have had it take up to a minute and thirty seconds for ~800 files (where the average is still something like 3 seconds).
My question is this: Is there something obvious that I am doing wrong, or is there a better way to handle reading files in that I have overlooked? What could be causing this inconsistency within the program?
If more in-depth timing information or other sections of the code are needed, I will provide. I do not believe that I can provide access to the data that I have been running the tests on, though.
A reason is not clear from your code. However, you can optimize some part and maybe that reduces the time. Namely, you ReDim on each iteration and this can cause memory management overhead. Instead, ReDim a fixed number of items, for example:
Dim nElms As Integer
...
nElms = 0
FileCount = 0
Do While FileName <> ""
FileCount = FileCount + 1
If (FileCount > nElms) Then
nElms = nElms + 250
ReDim Preserve FileArray(1 To nElms)
EndIf
Paul has suggested in his response that you need to use "fixed step" to re-dimension the array which seems to be one issue.
The other issue seems to be updating the form text continuously to show progress. If it is not too critical then you can think of changing it to something like below.
Declare dictionary object at the beginning of code before Loop.
Dim objDict As Object
objDict = CreateObject("Scripting.Dictionary")
And then modified block would be like shown below.
For i = LBound(FileSpec) + 1 To UBound(FileSpec)
FileName = Dir(FileSpec(i))
objDict.RemoveAll
Do While FileName <> ""
If Not objDict.Exists(FileName) Then objDict.Add FileName, FileName
FileName = Dir()
Loop
Select Case FoldIndex
Case 1
Call FormFunctionality.UpdateResults(objDict.Count & ": " & FileName & vbCrLf, "")
Case 2
Call FormFunctionality.UpdateResults("", objDict.Count & ": " & FileName & vbCrLf)
End Select
Next I
Test it on a backup!
I am trying to create a user form that takes user input and prints to a text file. I know the VBA scripting functions to print, store strings etc. BUT I'm new to userforms. How do you limit input and output to a text file? Add to that same file?
INPUT AND OUTPUT:
I would need to have this variety of
KEY FEATURES:
Limited Entry: XXXX means only enter 4 characters (The notepad file can only be certain characters long
Multiple Entries: After a set of records is entered to the text file, their values are stored and another input is allowed. Also the new entries have to be written to the same file on the next line
Space if left blank: If XXXX is left blank then four " " should be printed instead.
If you have part or all of these answers I'd like to hear from you!
---------------------------Edited with Adding Code-----------------------------
Private Sub Userform_Initialize()
'Fill Eggs
With Eggs
.AddItem "Eggs"
End With
End Sub
Private Sub CreateList_Click()
Dim myFile As String, myString As String
myFile = "C:\Reformatted.txt"
Open myFile For Output As #1
Dim fourChars As String * 4
fourChars = Milk.Value
myString = Eggs.Value + Milk.Value + Bread.Value
Print #1, myString
Close #1
Shell "C:\Windows\Notepad.exe C:\Reformatted.txt", 1
End Sub
So the above code launches this screen:
TextBox have MaxLength property. Default is set to 0 which does not limit character entry.
To limit the entry into a certain number, just change the value of this property to that number.
Now for replacing the XXXX with blank(if none or less than 4 is entered), take on SO advise in the comments.
Dim fourChars As String * 4
fourChars = TextBox1.Value
MsgBox Len(fourChars) ' will always return 4
This is a rather simple question.
I have a date variables formated like: 25_December_2010
I would like a statement or a bit of code in the VBA macro that will transform that string value from: 25_December_2010 to 25 December 2010.
Somehow be able to remove the underscores from inside the String value....
As I mentioned in comments, use code below:
Dim strDate As String
strDate = "25_December_2010"
strDate = Replace(strDate,"_"," ")
I wanted something similar in a macro I'm using for data cleaning so I took #simoco's answer and created a simple but mostly safe macro/sub.
Sub ConvertSpaceToUnderscore()
Dim strCellValue As String
' Use basic error handling if more than 1 cell is selected, or
' possibly if something that isn't a cell is selected.
On Error GoTo SelectionTooBig
strCellValue = Selection.Value
strCellValue = Replace(strCellValue, " ", "_")
Selection.Value = strCellValue
On Error GoTo 0
' Exit the sub if things went well
Exit Sub
SelectionTooBig:
MsgBox "Please select one cell at a time.", vbCritical, "Selection too large"
End Sub
I have a template document in Word 2013 that has the user fill in a large number of Legacy Text FormFields. At the end of the document, I've included a button which compiles the answers into a string devoid of formatting, then copies it to the clipboard.
It works, but as each FormField is read, the Word document skips back and forth between each text field and the end of the document. It's visually alarming. Is there a way to gather the values of each FormField without Word moving the cursor/focus to each field as it is read?
Here's a sample of the code:
Private Sub cmdCreateNote_Click()
Call cmdClearNote_Click
Dim ff As FormFields
Set ff = ActiveDocument.FormFields
Dim Output As String
Output = ff("ddReviewType").Result & vbCrLf
If ff("chFacInfo").Result Then
Dim FacInfo
FacInfo = Array("Field1: ", _
"Field2: ", _
"Field3: ", _
"Field4: ", _
"Field5: ")
Output = Output & "FIRST SECTION" & vbCrLf
For Index = 1 To 5
If ff("chFacInfo" & Index).Result Then
Output = Output & FacInfo(Index - 1) & ff("txFacInfo" & Index).Result & vbCrLf
End If
Next
Output = Output & vbCrLf
End If
Dim FORange As Range
Set FORange = ActiveDocument.Bookmarks("FinalOutput").Range
FORange.Text = Output
ActiveDocument.Bookmarks.Add "FinalOutput", FORange
Selection.GoTo What:=wdGoToBookmark, Name:="FinalOutput"
Selection.Copy
End Sub
It appears that every time I access ActiveDocument.FormFields( x ).Result, the document focus goes to that element, then drops back to the end of the document again.
Any pointers?
Use the Bookmark object instead of the FormField. This will allow you to access the properties without changing the screen focus. See answer on Suppress unwanted jumping/scrolling on Word 2013 VBA Script for specifics on how to do this.
ActiveDocument.Bookmarks("myFieldName").Range.Fields(1).Result
Posting comment as answer, since it worked!
Try Application.ScreenUpdating = False before going through the FormFields and then setting it to True after, in order to minimize screen updating.