I have a word file (doc or docx) that follows a specific name pattern.
The pattern is:
XXXXXXX_X_XXXXXXXX_NNNNNNN_NNNNNNN_XXXXXXXXX.doc(x)
and an example is:
Contract_J_Smith_01032022_31032022_GOOGLE.doc(x)
My intention is to create a macro in Word that will get the name of the file, split it in parts by the underscore (_) and then create two variables (startdate and enddate) with the 4th and 5th parts of the filename in order to use them inside the document.
These parts are dates in the format ddMMyyyy.
Also, I want to check if these variables represent a true date, so if they are true, the variable remains as it is and if they are false, a warning text will replace the variable inside the document.
This warning text should be bold and red.
So far I have managed to write the following code:
Sub AutoOpen()
Dim aStory As Range
Dim aField As Field
Dim fname As String
Dim startdate As String
Dim enddate As String
fname = ActiveDocument.Name
startdate = Split(fname, "_")(3)
enddate = Split(fname, "_")(4)
startdate = Left(startdate, 2) & "/" & Mid(startdate, 3, 2) & "/" & Right(startdate, 4)
enddate = Left(enddate, 2) & "/" & Mid(enddate, 3, 2) & "/" & Right(enddate, 4)
If IsDate(startdate) = False Then
startdate = "Problem with start date in filename"
End If
If IsDate(enddate) = False Then
enddate = "Problem with end date in filename"
End If
With ActiveDocument
.Variables("startdate").Value = startdate
End With
With ActiveDocument
.Variables("enddate").Value = enddate
End With
For Each aStory In ActiveDocument.StoryRanges
For Each aField In aStory.Fields
aField.Update
Next aField
Next aStory
End Sub
The only things that are missing are making the text bold and red.
Any suggestions?
The simplest way to do this is to wrap the DOCVARIABLE fields in your document in an IF field, as shown below.
Here is a link to documentation on the IF Field if you are not familiar with it.
Related
I'm pretty newbie at coding in vba (i'm actually learning on the spot as i've been required to do it so), and I'm having a little trouble getting this right.
What I need is to be able to search for a value {clave} and then insert the current date into the adjacent cell, but I haven't found the way to do it without having it overwrite the very first match.
At first I thought I could do it with a Loop, but I can't quite put my finger on it and I've been running in circles.
Is I haven't found the solution, I just left it as it is, but heres my code:
Private Sub buscarbtn_Click()
Dim clv1
Dim rnng As Range
clv1 = clavebx.Value
'Insert date
prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6).Value = Date
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub
And a quick look at my table so you can picture what I'm trying to do.
Thank you in advance!
Once you found the CLAVE ID check if the cell value is empty, if not empty place the date value.
Private Sub buscarbtn_Click()
Dim clv1 As String
Dim rnng As Range
Dim clave_found As Range
clv1 = clavebx.Value
'Insert date
Set clave_found = prontuario1.Range("V:Z").Find(what:=clv1, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, -6)
With clave_found
If .Value = vbNullString Then
.Value = Date
Else
MsgBox "The [CLAVE] ID found with date: " & .Value
End If
End With
'This isn't really relevant, just calling some data into the userform
busbox.Value = Hoja4.Range("D7").Value
mrcbox.Value = Hoja4.Range("D5").Value
corridabox.Value = Hoja4.Range("D8").Value
namebox.Value = Hoja4.Range("D4") & " - " & Hoja4.Range("D6")
fechabox.Value = Date
End Sub
I have a PDF file that contains a table. I want to use Excel-VBA to search just the first column for an array of values. I have a work around solution at the moment. I converted the PDF to a text file and search it like that. The problem is sometimes these values can be found in multiple columns, and I have no way of telling which one it's in. I ONLY want it if it's in the first column.
When the PDF converts to text, it converts it in a way such that there is an unpredictable amount of lines for each piece of information, so I can't convert it back to a table in an excel sheet based on the number of lines (believe me, I tried). The current method searches each line, and if it sees a match, it checks to see if the two strings are the same length. But like I mentioned earlier, (in a rare case but it does happen) there will be a match in a column that is NOT the column I want to search in. So, I'm wondering, is there a way to extract a single column from a PDF? Or even the entire table as it stands?
Public Sub checkNPCClist()
Dim lines As String
Dim linesArr() As String
Dim line As Variant
Dim these As String
lines = Sheet2.Range("F104").Value & ", " & Sheet2.Range("F105").Value & ", " & Sheet2.Range("F106").Value & ", " & Sheet2.Range("F107").Value
linesArr() = Split(lines, ",")
For Each line In linesArr()
If line <> " " Then
If matchlinename(CStr(line)) = True Then these = these & Trim(CStr(line)) & ", "
End If
Next line
If these <> "" Then
Sheet2.Range("H104").Value = Left(these, Len(these) - 2)
Else: Sheet2.Range("H104").Value = "Nope, none."
End If
End Sub
Function matchlinename(lookfor As String) As Boolean
Dim filename As String
Dim textdata As String
Dim textrow As String
Dim fileno As Integer
Dim temp As String
fileno = FreeFile
filename = "C:\Users\...filepath"
lookfor = Trim(lookfor)
Open filename For Input As #fileno
Do While Not EOF(fileno)
temp = textrow
Line Input #fileno, textrow
If InStr(1, textrow, lookfor, vbTextCompare) Then
If Len(Trim(textrow)) = Len(lookfor) Then
Close #fileno
matchlinename = True
GoTo endthis
End If
End If
'Debug.Print textdata
Loop
Close #fileno
matchlinename = False
endthis:
End Function
I receive word ( .doc ) file names in this format -
MDouglas-DouglasM-02-01-2017-493058190498601
Wherein,
(1) " MDouglas-DouglasM- " remains static in the beginning of the name
(2) "02-01-2017" is the date, which keeps changing every day ( so next day it will be 02-02-2017, and so on
(3) finally, "-493058190498601", which again, keeps changing with every file.
I am only interested in the date "02-01-2017", which I want populated in the Word document at two places:
(1) in the body of the document, in place of typed "Month dd, yyyy",
(2), in the 2nd pg header of the document, in place of typed "Month dd, yyyy".
Again, the "Month dd, yyyy" is only typed twice in the document; one in the body and one in the 2nd pg header. And I want both places populated with the date in the expanded format, that is:
"February 1, 2017"
I could come up with the following macro:
Selection.HomeKey Unit:=wdStory
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
text:="FILENAME "
Selection.TypeParagraph
However, this only populates the complete filename at the top of the document. Please suggest (in word VBA).
This will extract the date, others can do the code for the Range field swap (I'd be interested in how this is done)
Option Explicit
Sub Test()
Dim dtExtracted As Date
dtExtracted = ExtractDate("MDouglas-DouglasM-", "MDouglas-DouglasM-02-01-2017-493058190498601")
End Sub
Function ExtractDate(ByVal sPrefix As String, ByVal sFileName As String)
Dim lPrefixLen As Long
lPrefixLen = Len(sPrefix)
If Left$(sFileName, lPrefixLen) = sPrefix Then
Dim sRemainder As String
sRemainder = Mid$(sFileName, lPrefixLen + 1)
Dim vSplit As Variant
vSplit = VBA.Split(sRemainder, "-")
ReDim Preserve vSplit(0 To UBound(vSplit) - 1)
Dim sReJoin As String
sReJoin = VBA.Join(vSplit, "-")
If VBA.IsDate(sReJoin) Then
ExtractDate = CDate(sReJoin)
End If
End If
End Function
I’m attempting to add formatted entries from a table in MSWord 2016 document to the autocorrect library (which is stored in normal.dotx as usual for formatted entries).
In the document I have a table containing two columns, the left column has the short text and the right column has the formatted long text for the autocorrect entries.
I have a working macro for storing unformatted text using the line AutoCorrect.Entries.Add Name:=ShortText, Value:=LongText.
I’m trying to modify it to use the AutoCorrect.Entries.AddRichText ShortText, longtext function which should then pick up the font and italics properties in the table.
I tried two methods.
FIRST - testAddRichText1
Here’s the code (removed some of the cosmetics)
Sub testAddRichText1()
Set oDoc = ActiveDocument
For i = 1 To oDoc.Tables(2).Rows.Count
If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
ShortText = Left(ShortText, Len(ShortText) - 2) 'remove the trailing CR and LF
longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2)
StatusBar = "Adding " & ShortText & " = " & longtext.Text
AutoCorrect.Entries.AddRichText ShortText, longtext
End If
Next i
MsgBox "done"
End Sub
Using this code, there are a number of unprintable characters at the end of the text extracted from the cell, mostly Chr(13)’s. I tried running a cleaner over the string to remove all non-printable characters, but there is something there that just won’t go away and causes a black box at the end of the corrected text when the autocorrect is used. I assume it’s some sort of secret word code that is in the table cell. Attempting to print the ASC value of it returns 13, but deleting it has no effect (just removes characters before the blackbox symbol).
SECOND testAddRichText2
I tried adding italics to my text string in my working model, and then using it with the AddRichText method. AddRichText expects a range and I haven’t been able to convert the text string into a range.
Here is that code
Sub testAddRichText2()
Set oDoc = ActiveDocument
Dim LongTextrng As Range
For i = 1 To oDoc.Tables(2).Rows.Count
If oDoc.Tables(2).Rows(i).Cells(1).Range.Characters.Count > 1 Then
ShortText = oDoc.Tables(2).Cell(Row:=i, Column:=1)
ShortText = Left(ShortText, Len(ShortText) - 2)
longtext = oDoc.Tables(2).Cell(Row:=i, Column:=2).Range
longtext = Left(longtext, Len(longtext) - 2)
LongTextrng.Text = longtext 'Fails
LongTextrng.Italic = True
StatusBar = "Adding " & ShortText & " = " & longtextrng.Text
AutoCorrect.Entries.Add Name:=ShortText, Value:=LongTextrng
End If
Next i
MsgBox "done"
End Sub
Your first example, testAddRichText1, is almost correct. It fails because although you have recognised the need to remove the trailing characters from ShortText you haven't done the same for longText.
To shorten a range you move the end of the range using the MoveEnd method. In this instance you need to move the end of the range back one character to remove the end of cell marker.
In your second example, testAddRichText2, the code fails because you have not assigned the range to the variable, LongTextrng, correctly. When assigning a value to an object variable you need to use the Set command, like this:
Set objVar = object
This did not fail in your first attempt because LongText has not been declared and is therefore assumed to be a Variant.
The code below will work for you:
Sub AddRichTextAutoCorrectEntries()
Dim LongText As Range
Dim oRow As Row
Dim ShortText As String
For Each oRow In ActiveDocument.Tables(2).Rows
If oRow.Cells(1).Range.Characters.Count > 1 Then
ShortText = oRow.Cells(1).Range.Text
ShortText = Left(ShortText, Len(ShortText) - 2)
'assign the range to the variable
Set LongText = oRow.Cells(2).Range
'move the end of the range back by 1 character
LongText.MoveEnd wdCharacter, -1
StatusBar = "Adding " & ShortText & " = " & LongText.Text
AutoCorrect.Entries.AddRichText Name:=ShortText, Range:=LongText
End If
Next oRow
End Sub
I am building a reconciliation tool via VBA that automates queries from my oracle database and a worksheet. When I run the query I want the user to input what ITEM (in this case pipeline) to query (the worksheet has many items) and the end/start dates. I am having trouble figuring out the following:
1) It is querying - if the value is NULL, how may I tell it to print out "DATA NOT AVAILABLE"
2) How can I clear up the old output from pipeline A, when I am querying pipeline B?
3) My dates are saved as strings in Oracle - how can I convert that to date?
Thank you!
Here is what I have so far:
Option Explicit
Option Base 1
Dim cnnObject As ADODB.Connection
Dim rsObject As ADODB.Recordset
Dim strGPOTSConnectionString As String
Dim startDate As Date
Dim endDate As Date
Dim strPipelineName As String
Dim strQuery As String
Sub ClickButton2()
Debug.Print ("Button has been clicked")
Dim Pipeline As String
Dim DateStart As Date
Dim DateEnd As Date
Pipeline = InputBox("Enter PipeLine", "My Application", "Default Value")
DateStart = InputBox("Enter Start Date", "My Application", DateTime.Date)
DateEnd = InputBox("Enter End Date", "My Application", DateTime.Date + 1)
Pipeline = Range("B1").Value
DateStart = Range("B2").Value
DateEnd = Range("B3").Value
strQuery = "select pipelineflow.lciid lciid, ldate, volume, capacity, status, " & _
"pipeline, station, stationname, drn, state, county, owneroperator, companycode, " & _
"pointcode, pottypeind, flowdirection, pointname, facilitytype, pointlocator, " & _
"pidgridcode from pipelineflow, pipelineproperties " & _
"where pipelineflow.lciid = piplineproperties.lciid " & _
"and pipelineflow.audit_active = 1 " & _
"and pipelineproperties.audit_active =1 " & _
"and pipelineflow.ldate >= '" & Format(DateStart, "dd-MMM-yyyy") & "' and pipelineflow.ldate < '" & Format(DateEnd, "dd-MMM-yyyy") & "' " & _
"and pipelineflow.ldate >= '" & DateStart & "' and pipelineflow.ldate < '" & DateEnd & "' " & _
"and pipelineproperties.pipeline = '" & Pipeline & "' "
Call PullZaiNetData(strQuery)
Call TieOut
End Sub
Sub PullZaiNetData2(ByVal strQry As String)
Set cnnObject = New ADODB.Connection
Set rsObject = New ADODB.Recordset
strGPOTSConnectionString = "DRIVER={Microsoft ODBC for Oracle}; SERVER=hhh; PWD=hhhh; UID=hhh"
cnnObject.Open strGPOTSConnectionString
rsObject.Open strQry, cnnObject, adOpenStatic
Worksheets("ZaiNet Data").Cells(1, 1).CopyFromRecordset rsObject
rsObject.Close
cnnObject.Close
Set rsObject = Nothing
Set cnnObject = Nothing
End Sub
Sub TieOut()
End Sub
Since you changed your questions, I'll add another answer.
1) It is querying - if the value is NULL, how may I tell it to print out "DATA NOT AVAILABLE"
Which value? I suspect that you mean when the query returns no records. To check this, test for rsObject.RecordCount = 0:
Dim ws As Worksheet
Set ws = Worksheets("ZaiNet Data")
ws.UsedRange.Clear '' remove results of previous query if any
If rsObject.RecordCount = 0 Then
ws.Cells(1, 1) = "DATA NOT AVAILABLE"
Else
ws.Cells(1, 1).CopyFromRecordset rsObject
End If
You can also test for one or both of rsObject.BOF or rsObject.EOF being true ("Beginning Of File" or "End Of File" respectively).
When developing things in VBA, especially when using new features that I'm unfamiliar with, I do lots of tests that output things to the Immediate Window. To help with this, I use the following little routine:
Sub Say(s as String)
Debug.Print s
End Sub
It makes it a little easier to generate testing output that typing "Debug.Print" all the time (even slightly easier than typing "Debug.P" + Enter using Intellisense).
So when you open your recordset, show the record count after it:
rsObject.Open strQry, cnnObject, adOpenStatic
Say rsObject.RecordCount & " records"
Do something like this any time you want to verify a value.
Later on, if you want to capture your debugging statements in a text file, you just need to change the operation of the Say() routine.
2) How can I clear up the old output from pipeline A, when I am querying pipeline B?
As shown in context above:
ws.UsedRange.Clear '' remove results of previous query if any
3) My dates are saved as strings in Oracle - how can I convert that to date?
You don't technically need to convert the resulting date strings to date values, you may find that just by putting them in a cell, Excel will treat them as date values.
You just need to make sure that the user's dates get converted to the format that the database is expecting.
Your query string as it stands above still shows two lines incorporating the user's dates. The one that uses Format() to convert them to "dd-MMM-yyyy" format is the one you want to keep. Delete the other line, making sure your string concatenating syntax is still correct.
To actually convert the date string to a date value though, you would use the CDate() function:
Sub DateTest()
Dim sDate As String
Dim dDate As Date
sDate = "09-Jul-2009"
dDate = CDate(sDate)
Say "sDate = " & sDate
Say "dDate = " & dDate
dDate = dDate + 1
Say "dDate = " & dDate
End Sub
Immediate Window output:
sDate = 09-Jul-2009
dDate = 7/9/2009
dDate = 7/10/2009
We can verify that it converted the string to a date value because it shows up in the default date format for my machine, and responds to date math (adding 1 day).
Answers to previous questions (paraphrased):
1) "how to make sure end date is after start date":
Valid date values are floating point numbers, so DateEnd should be >= DateStart. The whole number part is the number of days since 1900-01-01. The fractional part is the current time of day (eg 12 noon = 0.5).
2) "use fancy calendar entry controls for dates"
Look at the controls available under the Insert> Object menu (in Excel 2003 and earlier - it's in 2007 too, but in a different place). One of them is a Calendar control. Double-clicking it in the Objects list will insert it into the current cell and put the sheet into Design Mode. Right click the control and choose Properties. Type a cell address into the LinkedCell field. Then click the "Exit Design Mode" button from the little toolbar that should have popped up. Now when you select a date on the control, it will show the value in the cell you linked it to.
Similarly there is a drop down list control that you can use to select your pipeline types.
3) "why am I getting an error on DateEnd = Range("B3").Value?"
The DateEnd error is probably due to a missing or invalid value in the cell you specified, as I asked in my comment.
What version of Excel are you doing this in? Excel 2003