S
Snowfire
Using the code I have collected from various sources below I am trying to get the input from the userform textboxes into the various address fields toupdate Outlook "on the fly" but I can't seam to extract any input ? Can anyone suggest where I am going wrong please?
Sub AddNewContact1()
Dim TempForm 'As VBComponent
Dim Newtext As MSForms.TextBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim NewCommandButton4 As MSForms.CommandButton
Dim NewCommandButton5 As MSForms.CommandButton
Dim NewCommandButton6 As MSForms.CommandButton
Dim NewCommandButton7 As MSForms.CommandButton
Dim First_Name As String
Dim TextLocation As Integer
Dim X As Integer, i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim WasVisible As Boolean
Dim olapp As Outlook.Application
Dim olCi As Outlook.ContactItem
Set olapp = New Outlook.Application
Set olCi = olapp.CreateItem(olContactItem)
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 250
TempForm.Properties("Height") = 275
' Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = 1 To 10
Set Newtext = TempForm.Designer.Controls.Add("Forms.Textbox.1")
With Newtext
.Width = 230
.Height = 20
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = False
End With
TopPos = TopPos + 21
Next i
' Add the Manually Enter button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Save Above to Contacts in Outlook"
.Height = 24
.Width = 200
.Left = 24
.Top = 222
.BackColor = &HC0C0FF
.Font.Bold = True
.WordWrap = True
End With
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.InsertLines X + 1, "Sub CommandButton1_Click()"
.InsertLines X + 2, " "
.InsertLines X + 3, " "
.InsertLines X + 4, " Unload Me"
.InsertLines X + 5, " "
.InsertLines X + 6, " "
.InsertLines X + 7, "End Sub"
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
First_Name = UserForms(TempForm.Name).TextBox1.Value
MsgBox First_Name
With olCi
.FirstName = TempForm.TextBox1.Value
.LastName = TempForm.TextBox2.Text
.MobileTelephoneNumber = TempForm.TextBox3.Text
.Email1Address = TempForm.TextBox4.Text
.HomeAddressStreet = TempForm.TextBox5.Text
.HomeAddressCity = TempForm.TextBox6.Text
.HomeAddressState = TempForm.TextBox7.Text
.HomeAddressPostalCode = TempForm.TextBox8.Text
.SelectedMailingAddress = TempForm.TextBox9.Text
.Categories = "Business, Personal"
.Save
End With
Set olCi = Nothing
Set olapp = Nothing
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub
Sub AddNewContact1()
Dim TempForm 'As VBComponent
Dim Newtext As MSForms.TextBox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim NewCommandButton3 As MSForms.CommandButton
Dim NewCommandButton4 As MSForms.CommandButton
Dim NewCommandButton5 As MSForms.CommandButton
Dim NewCommandButton6 As MSForms.CommandButton
Dim NewCommandButton7 As MSForms.CommandButton
Dim First_Name As String
Dim TextLocation As Integer
Dim X As Integer, i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim WasVisible As Boolean
Dim olapp As Outlook.Application
Dim olCi As Outlook.ContactItem
Set olapp = New Outlook.Application
Set olCi = olapp.CreateItem(olContactItem)
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 250
TempForm.Properties("Height") = 275
' Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = 1 To 10
Set Newtext = TempForm.Designer.Controls.Add("Forms.Textbox.1")
With Newtext
.Width = 230
.Height = 20
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = False
End With
TopPos = TopPos + 21
Next i
' Add the Manually Enter button
Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Save Above to Contacts in Outlook"
.Height = 24
.Width = 200
.Left = 24
.Top = 222
.BackColor = &HC0C0FF
.Font.Bold = True
.WordWrap = True
End With
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.InsertLines X + 1, "Sub CommandButton1_Click()"
.InsertLines X + 2, " "
.InsertLines X + 3, " "
.InsertLines X + 4, " Unload Me"
.InsertLines X + 5, " "
.InsertLines X + 6, " "
.InsertLines X + 7, "End Sub"
End With
' Show the form
VBA.UserForms.Add(TempForm.Name).Show
First_Name = UserForms(TempForm.Name).TextBox1.Value
MsgBox First_Name
With olCi
.FirstName = TempForm.TextBox1.Value
.LastName = TempForm.TextBox2.Text
.MobileTelephoneNumber = TempForm.TextBox3.Text
.Email1Address = TempForm.TextBox4.Text
.HomeAddressStreet = TempForm.TextBox5.Text
.HomeAddressCity = TempForm.TextBox6.Text
.HomeAddressState = TempForm.TextBox7.Text
.HomeAddressPostalCode = TempForm.TextBox8.Text
.SelectedMailingAddress = TempForm.TextBox9.Text
.Categories = "Business, Personal"
.Save
End With
Set olCi = Nothing
Set olapp = Nothing
' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub