how do i use access data to write an word document? - vba

I want to write a basic examination report on word, and than using access form complete the "fields",
for example:
the student X was doing Y during the last year.
he had difficulties at: A
and done good job at: B
than ill have a table of students in access, with name, overall observation, goos and bads.
the name has to replace the X in the word letter, the overall will replace the Y and etc.
i found some blog that explains how to do this using word bookmarks, but for some reason, the code isn't working...
thats the code i tired (just for the name, i didn't put yet all the info,
Dim AddyLineVar As String
AddyLineVar = [FirstName] + " " + [LastName]
Set wrd = CreateObject("Word.application")
Dim mergedoc As String
mergedoc = Application.CurrentProject.Path
mergedoc = mergedoc + "\wow.dotx"
wrd.Documents.Add mergedoc
wrd.Visible = True
wrd.activedocument.Bookmark
wrd.Item("FIRSTNAME").range.Text = AddyLineVar
wrd.activedocument.PrintOut
wrd.activedocument.Close wddonotsavechanges
wrd.Quit

Related

Connecting to Access from Excel, then create table from txt file

I am writing VBA code for an Excel workbook. I would like to be able to open a connection with an Access database, and then import a txt file (pipe delimited) and create a new table in the database from this txt file. I have searched everywhere but to no avail. I have only been able to find VBA code that will accomplish this from within Access itself, rather than from Excel. Please help! Thank you
Google "Open access database from excel VBA" and you'll find lots of resources. Here's the general idea though:
Dim db As Access.Application
Public Sub OpenDB()
Set db = New Access.Application
db.OpenCurrentDatabase "C:\My Documents\db2.mdb"
db.Application.Visible = True
End Sub
You can also use a data access technology like ODBC or ADODB. I'd look into those if you're planning more extensive functionality. Good luck!
I had to do this exact same problem. You have a large problem presented in a small question here, but here is my solution to the hardest hurdle. You first parse each line of the text file into an array:
Function ParseLineEntry(LineEntry As String) As Variant
'Take a text file string and parse it into individual elements in an array.
Dim NumFields As Integer, LastFieldStart As Integer
Dim LineFieldArray() As Variant
Dim i As Long, j As Long
'Determine how many delimitations there are. My data always had the format
'data1|data2|data3|...|dataN|, so there was always at least one field.
NumFields = 0
For I = 1 To Len(LineEntry)
If Mid(LineEntry, i, 1) = "|" Then NumFields = NumFields + 1
Next i
ReDim LineFieldArray(1 To NumFields)
'Parse out each element from the string and assign it into the appropriate array value
LastFieldStart = 1
For i = 1 to NumFields
For j = LastFieldStart To Len(LineEntry)
If Mid(LineEntry, j , 1) = "|" Then
LineFieldArray(i) = Mid(LineEntry, LastFieldStart, j - LastFieldStart)
LastFieldStart = j + 1
Exit For
End If
Next j
Next i
ParseLineEntry = LineFieldArray
End Function
You then use another routine to add the connection in (I am using ADODB). My format for entries was TableName|Field1Value|Field2Value|...|FieldNValue|:
Dim InsertDataCommand as String
'LineArray = array populated by ParseLineEntry
InsertDataCommand = "INSERT INTO " & LineArray(1) & " VALUES ("
For i = 2 To UBound(LineArray)
If i = UBound(LineArray) Then
InsertDataCommand = InsertDataCommand & "'" & LineArray(i) & "'" & ")"
Else
InsertDataCommand = InsertDataCommand & LineArray(i) & ", "
End If
Next i
Just keep in mind that you will have to build some case handling into this. For example, if you have an empty value (e.g. Val1|Val2||Val4) and it is a string, you can enter "" which will already be in the ParseLineEntry array. However, if you are entering this into a number column it will fail on you, you have to insert "Null" instead inside the string. Also, if you are adding any strings with an apostrophe, you will have to change it to a ''. In sum, I had to go through my lines character by character to find these issues, but the concept is demonstrated.
I built the table programmatically too using the same parsing function, but of this .csv format: TableName|Field1Name|Field1Type|Field1Size|...|.
Again, this is a big problem you are tackling, but I hope this answer helps you with the less straight forward parts.

VBA optimization robust code

So I'm completely new to VBA. I have a java-fetish so I'm not new to programming, however manipulating office documents just seemed easier with VBA.
Anyway, on topic:
I'm currently automating things in the company (This example is creating a contract). However, using Java, I always learned to make robust code and although the VBA code now works, I'm not happy with it because it requires a lot of 'friendliness' of the user. So my question is (I hope you don't mind), could you give me a nudge in the right direction to make my code way more robust?
Here's the code:
Function spaties(Name As String) As String
' Function used to ensure the length of a String (Working with Range)
Dim index As Integer
While (Len(Name) < 30)
Name = Name + " "
Wend
spaties = Name
End Function
Sub Macro3()
'
' Macro3 Macro
'
'
'ActiveDocument.Range(26101, 26102).Text = "d"
StartUndoSaver
Dim firma As String
firma = InputBox("Voor welke onderaannemer? (Zonder hoofdletters)" + Chr(10) + "(nicu, sorin of marius)")
Dim werf As String
werf = InputBox("Over welke Werf gaat het?")
Dim datum As String
datum = InputBox("Op welke datum spreekt het contract? (dd/mm/yyyy)")
With ActiveDocument
.Range(25882, 25899).Text = datum
ActiveDocument.Range(575, 605).Text = spaties(werf)
ActiveDocument.Range(1279, 1309).Text = spaties(werf)
End With
Select Case Len(firma)
Case 4
With ActiveDocument
.Range(26168, 26181).Text = "Nicu Dinita"
.Range(26062, 26088).Text = "Badi Woodconstruct SRL"
.Range(11359, 11371).Text = "Nicu Dinita"
End With
Case 5
With ActiveDocument
.Range(26168, 26181).Text = "Asavei Sorin"
.Range(26062, 26088).Text = "BELRO INTERIOR DESIGN SRL"
.Range(11359, 11371).Text = "Asavei Sorin"
End With
Case 6
With ActiveDocument
.Range(26168, 26181).Text = "Ivan Maricel"
.Range(26062, 26088).Text = "Solomon & Aaron Construct"
.Range(11359, 11371).Text = "Ivan Maricel"
End With
End Select
Dim prijs As String
Dim besch As String
Dim eenh As String
Dim hoev As Integer
hoev = InputBox("Hoeveel artikels zijn er?")
Dim index As Integer
index = 1
While (index <= hoev)
besch = InputBox("Beschrijving van het artikel (engels)")
prijs = InputBox("prijs van het artikel")
eenh = InputBox("Eenheid van het artikel")
With ActiveDocument
.Range(5701, 5702).Text = "" + vbTab + spaties2(besch, prijs, eenh) + Chr(10) + vbTab
End With
index = index + 1
Wend
With ActiveDocument.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Text = "Raes G. Schrijnwerken BVBA" + vbTab + vbTab + datum + Chr(10) + "Robert Klingstraat 5" + Chr(10) + "8940 Wervik"
.Footers(wdHeaderFooterPrimary).Range.Text = "Overeenkomst tot onderaanneming" + Chr(10) + "met betrekking tot:" + werf
.Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:=wdAlignPageNumberRight
End With
If firma = "sorin" Then
ActiveDocument.Range(254, 255).ImportFragment "Z:\Raes Netwerk DATA\professioneel\004 Sjablonen\belro.docx", False
Else
If firma = "nicu" Then
With ActiveDocument
.Range(254, 255).ImportFragment "Z:\Raes Netwerk DATA\professioneel\004 Sjablonen\Nicu.docx", False
End With
Else
If firma = "marius" Then
ActiveDocument.Range(254, 255).ImportFragment "Z:\Raes Netwerk DATA\professioneel\004 Sjablonen\Marius.docx", False
End If
End If
End If
ActiveDocument.PrintOut
ActiveDocument.PrintOut
End Sub
Function spaties2(artikel As String, prijs As String, eenh As String) As String
'Another function to ensure length of String
Dim index As Integer
Dim eind As String
eind = "" + artikel + vbTab + vbTab + prijs + "€/" + eenh
While (Len(eind) < 100)
eind = eind + " "
Wend
spaties2 = eind
End Function
As you can see, the code is very basic. And although it works, it's no good to deliver.
The two defined Functions are simply formatting the String of the user because obviously the name of something is not always the same length.
I'd like to cut out the Range properties, because in my opinion, that's what makes the program so sensitive to changes.
Any and all suggestions are welcome.
note: For the moment, the contract can have three different 'target parties' so that's why the Select Case statement is there. It's going to be completely useless if it should grow but for now it works.
Here's one:
sName = Left(sName & Space(30), 30)
And I think it's better to use bookmarks as placeholders instead of using Range(start, end)
How to change programmatically the text of a Word Bookmark
I think that your code needs some Trim's, in order to avoid mistaken spaces before and after the names (when you use some inputboxes, I mean).
And you need to verify input dates, too.
For string concatenation, use the ampersand (&) better than the plus sign (+), in order to avoid mistaken sums.
Instead of Chr(10) I have some recommendations in order to make your code more readable:
Chr(13) = vbCr
Chr(10) = vbLf
Chr(13) & Chr(10) = vbCrLf
Verify that the files you are indicating exist.
Using Range with numerical values is definitely not reliable. Bookmarks, as Tim suggests or content controls if this is Word 2007 or later. Content Controls are Microsoft's recommendation, going forward, but I don't see any particular advantage one way or the other for your purpose.
Looking at all the InputBox calls I have to wonder whether displaying a VBA UserForm for the input might not be better? All the input fields in one place, rather than flashing multiple prompts. You can validate for correct input before the UserForm is removed from the screen, etc.

Get page number of IndirectObject in ABCPdf

I have a script which processes indirect objects from the object soup (it processes the images of the PDF).
So, I have the IndirectObject, and I need the page number on which it is:
var indiObj = sourceDoc.ObjectSoup[objectToProcess];
I have tried to use sourceDoc.GetInfo(indiObj.ID, "whatever"); but I have no idea which property to use as type, because I couldn't find any documentation of the list of possible properties.
I asked about the version because I'm working with version 7 :(
It's an interesting question (IMHO). I thought first that this could be useful:
oDoc.ObjectSoup.Catalog.Pages.GetPageArray
But, altough you get the pages, you can't get the object soup for each page (at least in version 7) .....
So, maybe, you can try something like this, as PDF code in 'objects soup' it's order from top to botton:
Dim oDoc As New WebSupergoo.ABCpdf7.Doc
Using oDoc
oDoc.Read(path_to_your_PDF)
Dim iPage As Integer = 0
Dim sType As String
For iAux As Integer = 0 To oDoc.ObjectSoup.Count - 1
sType = oDoc.ObjectSoup(iAux).GetType.ToString()
Select Case sType
Case "WebSupergoo.ABCpdf7.Objects.Page"
iPage += 1
Debug.Print(vbNewLine & "Page " & iPage.ToString & " detected")
Case "WebSupergoo.ABCpdf7.Objects.PixMap"
Dim oPDFImg As WebSupergoo.ABCpdf7.Objects.PixMap
oPDFImg = CType(oDoc.ObjectSoup(iAux), WebSupergoo.ABCpdf7.Objects.PixMap)
Debug.Print(vbNewLine & "Image on page " & iPage.ToString & " -> ID " & oPDFImg.ID.ToString)
End Select
Next
End Using
You can use a "typeof" instead of that Select Case (change 'ABCpdf7' to 'ABCpdf9', anyway). Hope it helps.

vba ADOBE.recordset filter/find

I have a ADOBE.Recordset in Excel VBA returned from a query to database. How should I find a certain record in this set that fits certain criteria? Below is the code. Could anyone fill in the " 'print out the name of one person whose age is i" part for me? Thanks in advance!
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
'print out the name of one person whose age is i
Next i
Update 1:
Thanks KazJaw! I think your solutions should work. However, I am looking for a cleaner solution -
I don't want to save the query results into a sheet. I'd prefer them in memeory.
Is there a .Find or .Search function I can use so that I don't need to implement the search with a loop (as you did in the Second Solution)?
Maybe I am being greedy here, but ideally, I'd like something like this:
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
Apologies for the formatting. I am new to the site, not sure how to properly indent the two lines in the For loop.
Update 2:
Yes KazJaw, other problem rises. ".Find" requires rs to be able to scrolled back, which requires its lockType to be set to adLockOptimistic. Haven't figured out how yet. Will post if I do.
Solution:
The Key is to use rs.Open instead of conn.Execute and to set CursorType.
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US' Order By i"
Set rs = New ADODB.Recordset
rs.Open Source:=q, CursorType:=adOpenStatic, ActiveConnection:=ThisWorkbook.conn 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
First solution, without looping, you could do it in this way but you need to stick to #mehow suggestion where age condition should be implemented in SQL query.
'return all results as of cell A2, direction down+right, in activesheet
ActiveSheet.Range("A2").CopyFromRecordset rs
Second solution, with looping, instead of your For i...Next loop try below solution.
Dim lRow as long
lRow=2
With rs
Do Until .EOF
'return only those which age equals to i
'if implemented in SQL query then you could get rid of if statement below
if .Fields(1).Value = i then
Cells(lRow, 1) = .Fields(1).Value
Cells(lRow, 2) = .Fields(2).Value
.MoveNext
lRow = lRow + 1
end if
Loop
End With
Third solution. If you really need to use .Find method then do it in this way:
'...your loop here
rs.Find "age = " & i
name = rs(0)
MsgBox name & "'s age is " & i
'... rest of your code here
Unfortunately, I'm not sure if it will work. I think you will need to sort your results by age within SQL code. If not I expect some of the ages can be omit. Some other problems could arise. Therefore try with other solutions.

VBA Word: Inserting Text Form Fields at a Specified Location

I am new to vba and developing a document that prompts the user to select a variable number of values from a combo box list. After selecting the values, I want to insert them in order onto the document itself as a Text Form Field. Let me show you how I generally am trying to get it to work.
First, the user selects values:
[a]
[b]
[c]
And selects an "OK" button. Then, I am attempting to add these selected values into the word document starting at a bookmark. Value "a" should be inserted followed by a space character followed by a blank Text Form Field, followed by two carriage returns. In the end the result should look something like this:
[bookmark]
[a]'_'[blank_a]'^p'
'^p'
[b]'_'[blank_b]'^p'
'^p'
[c]'_'[blank_c]'^p'
'^p'
Where [bookmark] is an invisible bookmark, '_' is a space, and '^p' is a carriage return. Currently my code is as follows:
Dim myRange As Range
Set myRange = ActiveDocument.Range(Start:=ActiveDocument.Bookmarks("START").Range.Start, _
End:=ActiveDocument.Bookmarks("END").Range.End)
For i = 1 To NUMBER_OF_RESPONSES
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Name = "question_" & i
Selection.FormFields.Add(myRange, wdFieldFormTextInput).Result = "response_" & i
Next i
Naturally, there are no insertions of literal spaces or carriage returns yet as I have not figured out how to do it. The result of this code is as follows:
[START][blank_c][c][blank_b][b][blank_a][a][END]
I would like this order reversed and for there to be the aforementioned formatting inserted. Any pointers on how to go about doing it?
I am not sure if I have missed something, but why not relying on simple paragraphs instead on Bookmarks? Here you have a code doing what you want and any other thing (you can modify the ranges of the paragraphs to perform as complex actions as you wish).
Dim curRange As Range
Dim start_i As Integer
Dim end_i As Integer
Dim NUMBER_OF_RESPONSES As Integer
NUMBER_OF_RESPONSES = 3
start_i = NUMBER_OF_RESPONSES + 1 '0
end_i = 1 'NUMBER_OF_RESPONSES
Set curParagraph = ActiveDocument.Paragraphs.First
curParagraph.Range.Text = "[START]"
i = start_i
Do
If (start_i < end_i) Then
i = i + 1
Else
i = i - 1
End If
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[question_" & i & "][" & "response_" & i & "]"
Loop While (i <> end_i)
Set curParagraph = curParagraph.Range.Paragraphs.Add
curParagraph.Range.Text = "[END]"
Solution
Well now I feel silly for asking the question. The solution was pretty simple.
ActiveDocument.Bookmarks("START").Select
For i = 1 To NUMBER_OF_RESPONSES
Selection.Font.Size = 11
Selection.Font.Bold = True
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "question_" & i
Selection.Font.Bold = False
Selection.TypeText Text:=" "
Selection.FormFields.Add(Range:=Selection.Range, Type:=wdFieldFormTextInput) _
.Name = "response_" & i
Selection.TypeParagraph
Selection.TypeParagraph
Next i
So the real issue was placing the cursor in the right location:
ActiveDocument.Bookmarks("START").Select
From there I was able to use Selection to insert the desired FormFields and characters.
This link was pretty helpful.
And if you are reading this because you also are new and trying to learn what to do, check out how to record a macro. It's a good first step. Record the macro, view the code it generated, and use that code to guide your own development. Cool.