Re: combo box, drop down - dynamic populate

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance



works fine within my document_new.
So as to use more than once, say upon entry into "Policy" form field, I made
a seperate macro to call this UF. If I leave this in doc new it works fine
but, when I call a macro the userform pops up outside of the form and does
not return variables correctly from another sql.
Can you not set this up as it's own macro?
Here's my code if I call from doc_new.....
....
call getUF
....
sub getUF()
Set UF = New UserForm1
UF.ClientID = ActiveDocument.FormFields("Text2").Result
UF.Show

strpolicy = UF.ComboBox1.Text

strprefix = Left(strpolicy, 2)
strpoln = Mid(strpolicy, 5, 9)
strstatus = Mid(strpolicy, 22, 2)
Set UF = Nothing
'''
Set objConn2 = CreateObject("ADODB.Connection")
objConn2.Open "Provider=IBMDA400.DataSource.1;Password=decs;Persist
Security Info=True;User ID=decs;Data Source=s1033781"

If strstatus = "En" Then
strquery2 = "select pmtecn as cn, pmteyy as yy, pmtemm as mm, pmtedd
as dd from prddta.papomf where prddta.papomf.pmprfx = '" + strprefix + "'"
strquery2 = strquery2 & " and prddta.papomf.pmplnr = '" + strpoln +
"'"
Else
strquery2 = "select pmexcn as cn, pmexyy as yy, pmexmm as mm, pmexdd
as dd from prddta.papomf where prddta.papomf.pmprfx = '" + strprefix + "'"
strquery2 = strquery2 & " and prddta.papomf.pmplnr = '" + strpoln +
"'"
End If

Set ef = objConn2.Execute(strquery2)

If Not ef.EOF Then
strlicn = ef("cn").Value
strliyy = ef("yy").Value
strlimm = ef("mm").Value
strlidd = ef("dd").Value
If Len(strlicn) = 1 Then
strlicn = "0" & strlicn
End If
If Len(strliyy) = 1 Then
strliyy = "0" & strliyy
End If
If Len(strlimm) = 1 Then
strlimm = "0" & strlimm
End If
If Len(strlidd) = 1 Then
strlidd = "0" & strlidd
End If
strexyyyy = strlicn & strliyy
strRD = strlimm & "/" & strlidd & "/" & strexyyyy
ActiveDocument.FormFields("Text3").Result = Trim(strRD)
End If
Set ef = Nothing
objConn2.Close
Set objConn2 = Nothing
'''

ActiveDocument.FormFields("Policy").Result = Left(strpolicy, 13)
end sub

my userform looks like this:
Public ClientID As String

Private Sub UserForm_Activate()

strCLLen = Len(ClientID)

Do Until strCLLen = 12
ClientID = "0" & ClientID
strCLLen = Len(ClientID)
Loop

'As/400
Set objConn1 = CreateObject("ADODB.Connection")
objConn1.Open "Provider=IBMDA400.DataSource.1;Password=decs;Persist
Security Info=True;User ID=decs;Data Source=s1033781"
strquery1 = "select pmprfx, pmplnr, pmstat, pmnnrs, pmreni from
prddta.papomf where prddta.papomf.pmclid = '" + ClientID + "'"
strquery1 = strquery1 & " and prddta.papomf.poltyp in('70', '80')"
Dim zd
Set zd = CreateObject("ADODB.Recordset")
zd.Open strquery1, objConn1, 2, 3
If Not zd.EOF Then
zd.MoveFirst

Do While Not zd.EOF
strprfx = zd("pmprfx").Value
strPol = CStr(zd("pmplnr").Value)
strstat = zd("pmstat").Value
strreason = zd("pmnnrs").Value
strreni = zd("pmreni").Value
Select Case strstat
Case "E"
stat = "Entered"
Case "A"
stat = "Active"
Case "L"
stat = "Lapsed"
Case "C"
stat = "Cancelled"
Case "X"
stat = "Expired"
End Select

If strreason = "03" And strstat <> "C" And strstat <> "L" Then
stat = "Converted"
End If
If strreni = "Z" And strreason <> "" And strstat <> "C" And strstat
<> "L" Then
stat = "Non-Renew"
End If

ComboBox1.AddItem strprfx + " " + strPol + " " + stat
'ComboBox1.AddItem strprfx '+ " " + zd("pmplnr").Value


zd.MoveNext

Loop
End If

objConn1.Close
Set objConn1 = Nothing

ComboBox1.ListIndex = 0
End Sub

Private Sub CommandButton1_Click()
Dim i As Integer, Addressee As String
Addressee = ""
For i = 1 To ComboBox1.ColumnCount
ComboBox1.BoundColumn = i
Addressee = ComboBox1.Value
Next i
'UserForm1.Hide

Me.Hide
End Sub

As I said if I leave all inside doc_new it works fine but, not if I set up
as a macro.

Also if you have a change and since you're so well versed I created a new
question on Adding a file (inserting same doc/file multiple times and
populating info).

Thanks,
Bryan


"Jay Freedman" wrote:

That will probably work (although I can't test it because I don't have your
database), but it can be simplified:

zd.Open strquery1, objConn1, 2, 3
If Not zd.EOF Then
zd.MoveFirst
Do While Not zd.EOF
ComboBox1.AddItem zd("pmprfx").Value + " " + zd("pmplnr").Value
zd.MoveNext
Loop
End If


bryan wrote:
addendum.
Here's what I have

strquery1 = "select pmprfx, pmplnr from prddta.papomf where
prddta.papomf.pmclid = '" + ClientID + "'"
Dim zd
Set zd = CreateObject("ADODB.Recordset")
zd.Open strquery1, objConn1, 2, 3
If Not zd.EOF Then
zd.MoveFirst
i = 0
Do While Not zd.EOF
ComboBox1.AddItem (i)
ComboBox.Column(0, i) = zd("pmprfx").Value + " " +
zd("pmplnr").Value

zd.MoveNext
i = i + 1
Loop
End If


Thanks,
Bryan

--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.



.



Relevant Pages

  • Re: combo box, drop down - dynamic populate
    ... sub getUF() ... Set objConn2 = CreateObject ... If strstatus = "En" Then ... stat = "Entered" ...
    (microsoft.public.word.vba.general)
  • Re: combo box, drop down - dynamic populate
    ... If you make sure the ClientID field is the first field in the template, ... Then assign the calling macro as the entry macro for the Policy field, ... sub getUF() ... stat = "Entered" ...
    (microsoft.public.word.vba.general)
  • Re: combo box, drop down - dynamic populate
    ... In document_new I called a macro th do the UF ... and also put this Run macro in entry of form field "Policy", ... sub getUF() ... stat = "Entered" ...
    (microsoft.public.word.vba.general)
  • Re: Removing Command Button
    ... Sub AAA ... Workbooks("Excel Macro File.xls").Close False ... the Excel window just froze. ... button is created on the Standard toolbar after the macro file is opened. ...
    (microsoft.public.excel.programming)
  • Re: Removing Command Button
    ... will not find it and thus not execute it. ... Private Sub Auto_Open ... Workbooks ("Excel Macro File.xls").Windows.Visible = False ... Private Sub Macro() ...
    (microsoft.public.excel.programming)