Format Name in Cells

[HansV]

Sorry, that's my mistake, it should be xlApp instead of Application.

Code: Select all

          If i = 1 Then ' This will become column 2, so apply Proper
              .Cells(iDataRow, i + 1).Value = xlApp.Proper(Trim(Split(StrData, Sep)(i)))
          Else ' Otherwise simply add the value
              .Cells(iDataRow, i + 1).Value = Trim(Split(StrData, Sep)(i))
          End If

[arroway]

There it is!!! Thanks so much for all the help and for forgiving me for not knowing enought to keep out of trouble!

[HansV]

Phew!

[PJ_in_FL]

It throws a Compile error: Method or data member not found.
When I hit OK, the ".Proper" characters of the code are highlighted.

Are you running the macro in Word or Excel? The .Proper function is an Excel worksheet function.

If running the macro in Word, add these lines to the start of the macro:

Code: Select all

 Dim XL As Object

      Set XL = CreateObject("Excel.Application")

and change the .Proper statement to:

Code: Select all

.Cells(iDataRow, i + 1).Value = XL.Proper(Trim(Split(StrData, Sep)(i)))

... in other words, what Hans said

[arroway]

Hi Hans,
I have another addition that I'd like to make to this code. Can you help me out? The form has a form-type (Initial, Appeal, and Retroactive Review) which I'm trying to capture and get inserted into the Excel document. Same code as above. I originally put in 3 bookmarked checkboxes but learned that this runs the possiblity of folks selecting more than one of them which is not desireable. Radio Button functionality is what I'm looking for so what I've added are three Active-X control buttons with the above cpations. Initial is set to True so it defaults when the form is open. What I'm looking for is how to get the value from the selected button into the Excel documnet. The value for each should be "Initial", "Appeal", and "Retro" but I'm not sure how to set the value so it connects to the True state of the selected button and then into Excel. I've left the control name as the default OptionButton1, OptionButton2, and OptionButton3 and (I'm not sure if I needed to set this or not but) the groupname is "aAuthTypeButton".

OK, so here goes my attempt at writting the VBA. Look out! I need the value inserted into the spreadsheet in column "L". I'm guessing the bookmarked name is the groupname? So the code might look something like this:

Code: Select all

Sub IPLogInsert()
Dim StrBkMk As String, StrData As String, StrIn As String, Sep As String, i As Long
Dim xlApp As Object, xlWkBk As Object, xlWsh As Object, StrWkBkNm As String
Dim bStrt As Boolean, r As Long, iDataRow As Long, bFound As Boolean, StrXlPwd As String
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem

StrWkBkNm = "H:\My File Location\Numbers.xlsm" 'Excel spreadsheet location
StrBkMk = "bMedicaidNum,bLname,bFname,,bDOB,VOL,bIPHospital,Inits,ciCallDate,,dInitDaysAuthFrom,dInitDaysAuthThru,,[b]aAuthTypeButton[/b],,,bTxAgencyName"
Sep = "|" ' Data Separator Character
StrXlPwd = "MyPassword" '"Password" 'Password for the Excel file

With ActiveDocument
        For i = 0 To UBound(Split(StrBkMk, ","))
    If i = 1 Then
      StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & ", "
    ElseIf i = 2 Then
      StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
    ElseIf i = 5 Then
      StrData = StrData & "VOL" & Sep
      ElseIf i = 6 Then
        If .FormFields(Split(StrBkMk, ",")(i)).Result = "Other" Then
            StrData = StrData & .FormFields("bIPHospOther").Result & Sep
        Else
            StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
        End If
    ElseIf i = 9 Then
      StrData = StrData & Sep
    ElseIf i = 12 Then
      StrData = StrData & Sep
    ElseIf i = 13 Then
      StrData = StrData & Sep
    ElseIf i = 14 Then
      StrData = StrData & Sep
    ElseIf i = 15 Then
      StrData = StrData & Sep
    [b]Elseif i = 17 Then
       IF StrData=(OptionButton1, true, "Intial") & Sep
       Elseif StrData=(OptionButton2, true, "Appeal") & Sep
       Else StrData=(OptionButton3, true, "Retro") & Sep[/b]   'Oh who the hell am I kidding?  I have NO IDEA what I'm going!   :stupidme:  
    ElseIf i = 7 Then
      While Trim(StrIn) = vbNullString Or InStr(StrIn, Sep) > 0
        StrIn = InputBox("Please add your initials.  (In CAPS please.)", "User Initials")
      Wend
      StrData = StrData & StrIn & Sep
    ElseIf i = UBound(Split(StrBkMk, ",")) Then
      StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result
    Else
      StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
    End If
  Next
End With
' Test to see if there is a copy of Microsoft Excel already running.
On Error Resume Next
bStrt = False ' Flag to say whether we've started Excel, so we can close it later
Set xlApp = GetObject(, "Excel.Application")
'Start Excel if it isn't running
If xlApp Is Nothing Then
  Set xlApp = CreateObject("Excel.Application")
  If xlApp Is Nothing Then
    MsgBox "Can't start Excel.", vbExclamation
    Exit Sub
  Else
  End If
  bStrt = True
End If
On Error GoTo 0
'Check if the workbook is open
With xlApp
  bFound = False
  For Each xlWkBk In .Workbooks
    If xlWkBk.FullName = StrWkBkNm Then ' It's open
      Set xlWkBk = xlWkBk
      bFound = True
      Exit For
    End If
  Next
  ' Not open, so open it
  If bFound = False Then
    If IsFileLocked(StrWkBkNm) = True Then
      MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      Exit Sub
    End If
    Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, Password:=StrXlPwd)
    If xlWkBk Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrWkBkNm
      Exit Sub
    End If
  End If
  ' Update the workbook
  With xlWkBk
    Set xlWsh = .Worksheets(1)
    ' Identify the worksheet to update
      If ActiveDocument.FormFields("bEnT").CheckBox.Value Then
      Set xlWsh = .Worksheets("EnT_2014")
    Else
      Set xlWsh = .Worksheets("2014")
    End If
    ' Update the first available row in the worksheet,
    ' skipping over any columns for which there are no data
    With xlWsh
      iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row + 1 ' -4162 = xlUp
      For i = 0 To UBound(Split(StrData, Sep))
        If Trim(Split(StrData, Sep)(i)) <> vbNullString Then
          .Cells(iDataRow, i + 1).Value = Trim(Split(StrData, Sep)(i))
        End If
      Next
    End With
  End With
  MsgBox "Workbook updates finished.", vbOKOnly
  xlApp.Visible = True
  AppActivate "Microsoft Excel"
End With


'Email Function to send email

On Error Resume Next

'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
    'Outlook wasn't running, start it from code
    Set oOutlookApp = CreateObject("Outlook.Application")
     bStarted = True
End If

'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem
     'Set the recipient for the new email
   .To = "person1@myplace.com"
     'Set the subject
    .Subject = "NOTIFICATION: IP Log Submital"
     'The content of the document is used as the body for the email
    .Body = "Someone hit the Submit Button!"
     .Send
End With

If bStarted Then
     'If we started Outlook from code, then close it
    oOutlookApp.Quit
End If

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing

End Sub

OK so i have NO CLUE! I hope that was good for a laugh.

Can you help?
--Dax

[HansV]

ActiveX option buttons do not have a bookmark name. You can look at their value directly:

Code: Select all

        If .OptionButton1 Then
            StrData = StrData & "Initial" & Sep
        ElseIf .OptionButton2 Then
            StrData = StrData & "Appeal" & Sep
        ElseIf .OptionButton3 Then
            StrData = StrData & "Retro" & Sep
        End If

The above belongs within the With ActiveDocument ... End With block.

Therefore aAuthTypeButton does not belong in the StrBkMk string, but I don't know what the consequences would be if I just removed it, so I left it there.
Here is the complete code, with consistent indentation to make the code a bit more readable:

Code: Select all

Sub IPLogInsert()
    Dim StrBkMk As String, StrData As String, StrIn As String, Sep As String, i As Long
    Dim xlApp As Object, xlWkBk As Object, xlWsh As Object, StrWkBkNm As String
    Dim bStrt As Boolean, r As Long, iDataRow As Long, bFound As Boolean, StrXlPwd As String
    Dim bStarted As Boolean
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem

    StrWkBkNm = "H:\My File Location\Numbers.xlsm" ' Excel spreadsheet location
    StrBkMk = "bMedicaidNum,bLname,bFname,,bDOB,VOL,bIPHospital,Inits,ciCallDate,,dInitDaysAuthFrom,dInitDaysAuthThru,,aAuthTypeButton,,,bTxAgencyName"
    Sep = "|" ' Data Separator Character
    StrXlPwd = "MyPassword" ' Password for the Excel file

    With ActiveDocument
        For i = 0 To UBound(Split(StrBkMk, ","))
            If i = 1 Then
                StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & ", "
            ElseIf i = 2 Then
                StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
            ElseIf i = 5 Then
                StrData = StrData & "VOL" & Sep
            ElseIf i = 6 Then
                If .FormFields(Split(StrBkMk, ",")(i)).Result = "Other" Then
                    StrData = StrData & .FormFields("bIPHospOther").Result & Sep
                Else
                    StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
                End If
            ElseIf i = 7 Then
                Do While Trim(StrIn) = vbNullString Or InStr(StrIn, Sep) > 0
                    StrIn = InputBox("Please add your initials.  (In CAPS please.)", "User Initials")
                Loop
                StrData = StrData & StrIn & Sep
            ElseIf i = 9 Then
                StrData = StrData & Sep
            ElseIf i = 12 Then
                StrData = StrData & Sep
            ElseIf i = 13 Then
              StrData = StrData & Sep
            ElseIf i = 14 Then
              StrData = StrData & Sep
            ElseIf i = 15 Then
                StrData = StrData & Sep
            ElseIf i = UBound(Split(StrBkMk, ",")) Then
                StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result
            Else
                StrData = StrData & .FormFields(Split(StrBkMk, ",")(i)).Result & Sep
            End If
        Next i

        If .OptionButton1 Then
            StrData = StrData & "Initial" & Sep
        ElseIf .OptionButton2 Then
            StrData = StrData & "Appeal" & Sep
        ElseIf .OptionButton3 Then
            StrData = StrData & "Retro" & Sep
        End If
    End With

    ' Test to see if there is a copy of Microsoft Excel already running.
    On Error Resume Next
    bStrt = False ' Flag to say whether we've started Excel, so we can close it later
    Set xlApp = GetObject(, "Excel.Application")
    'Start Excel if it isn't running
    If xlApp Is Nothing Then
        Set xlApp = CreateObject("Excel.Application")
        If xlApp Is Nothing Then
            MsgBox "Can't start Excel.", vbExclamation
            Exit Sub
        End If
        bStrt = True
    End If
    On Error GoTo 0
    'Check if the workbook is open
    With xlApp
        bFound = False
        For Each xlWkBk In .Workbooks
            If xlWkBk.FullName = StrWkBkNm Then ' It's open
                Set xlWkBk = xlWkBk
                bFound = True
                Exit For
            End If
        Next xlWkBk
        ' Not open, so open it
        If bFound = False Then
            If IsFileLocked(StrWkBkNm) = True Then
                MsgBox "The Excel workbook is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
                Exit Sub
            End If
            Set xlWkBk = .Workbooks.Open(FileName:=StrWkBkNm, Password:=StrXlPwd)
            If xlWkBk Is Nothing Then
                MsgBox "Cannot open:" & vbCr & StrWkBkNm
                Exit Sub
            End If
        End If
        ' Update the workbook
        With xlWkBk
            Set xlWsh = .Worksheets(1)
            ' Identify the worksheet to update
            If ActiveDocument.FormFields("bEnT").CheckBox.Value Then
                Set xlWsh = .Worksheets("EnT_2014")
            Else
                Set xlWsh = .Worksheets("2014")
            End If
            ' Update the first available row in the worksheet,
            ' skipping over any columns for which there are no data
            With xlWsh
                iDataRow = .Cells(.Rows.Count, 1).End(-4162).Row + 1 ' -4162 = xlUp
                For i = 0 To UBound(Split(StrData, Sep))
                    If Trim(Split(StrData, Sep)(i)) <> vbNullString Then
                        .Cells(iDataRow, i + 1).Value = Trim(Split(StrData, Sep)(i))
                    End If
                Next i
            End With
        End With
        MsgBox "Workbook updates finished.", vbOKOnly
        xlApp.Visible = True
        AppActivate "Microsoft Excel"
    End With

    'Email Function to send email
    On Error Resume Next
    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With oItem
        'Set the recipient for the new email
        .to = "person1@myplace.com"
        'Set the subject
        .Subject = "NOTIFICATION: IP Log Submital"
        'The content of the document is used as the body for the email
        .Body = "Someone hit the Submit Button!"
        .Send
    End With

    If bStarted Then
        'If we started Outlook from code, then close it
        oOutlookApp.Quit
    End If

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing
End Sub

[arroway]

Interesting. I'm testing with "Retro" selected. When I run this it runs and throws no errors but it appends the "Retro" to the bTxAgencyName bookmarked text. This is in column O on in the spreadsheet. I'm trying to get the RadioButton result into column L. Should the "i" be connected to a number, as in, Elseif i = 13 Then If .OptionButton1... Or should it be directed with something like a xlWsh.Cells(iDataRow, "L") statement?

The "aAuthTypeButton" was just a guess so I took it out and returned the code back to what it was.

[HansV]

Should the "i" be connected to a number, as in, Elseif i = 13 Then If .OptionButton1...

I'd try that.

[arroway]

Holy Crap I did it! Haha!!! There might be some hope for me yet! Thanks for your help and guideance Hans!!!