MODIFIED SOURCE CODE FOR ATTACH.FRM

ATTACH.FRM contained 9 resource strings and 4 non-user interface strings.

Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
'ResMe Converted To A Property: Const FORMCAPTION = "Attachments"
'ResMe Converted To A Property: Const BUTTON1 = "&New"
'ResMe Converted To A Property: Const BUTTON2 = "&ReAttach"
'ResMe Converted To A Property: Const BUTTON3 = "&Close"
'>>>>>>>>>>>>>>>>>>>>>>>>

Sub cmdClose_Click()
  Unload Me
End Sub

Sub cmdNew_Click()
  frmNewAttach.Show vbModal
End Sub

Sub cmdReAttach_Click()
  On Error GoTo REAErr
  
  Dim i As Integer
  Dim sTmp As String
  
  Screen.MousePointer = vbHourglass

  'execute the refreshlink method on all the selected items
  For i = 0 To lstTables.ListCount - 1
    If lstTables.Selected(i) Then
      sTmp = Trim$(Left$(lstTables.Text, InStr(lstTables.Text, vbTab)))
      gdbCurrentDB.TableDefs(sTmp).RefreshLink
    End If
  Next
  
  MsgBar vbNullString, False
  Screen.MousePointer = vbDefault
  Exit Sub
  
REAErr:
  ShowError
  If i > 0 Then
    Resume Next    'try to continue
  End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016086
  End If
End Sub

Sub Form_Load()
    'ResMe autogenerated line of code to call the initialization routine that was automatically generated.
    Call frmAttachments_Auto_Init
  On Error GoTo FLErr

  Dim tdf As TableDef
  Dim i As Integer
  
  Me.Caption = FORMCAPTION
  cmdNew.Caption = BUTTON1
  cmdReAttach.Caption = BUTTON2
  cmdClose.Caption = BUTTON3
  
  'get the attached tables from the tabledefs collection
  For Each tdf In gdbCurrentDB.TableDefs
    If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Or _
       (tdf.Attributes And dbAttachedODBC) = dbAttachedODBC Then
      lstTables.AddItem tdf.Name & String(32 - Len(tdf.Name), " ") & vbTab & tdf.SourceTableName & "=>" & tdf.Connect
    End If
  Next
  Me.Height = 3360
  Me.Width = 6195
  Me.Top = 1000
  Me.Left = 1000
  
  Screen.MousePointer = vbDefault
  Exit Sub
  
FLErr:
  ShowError
  Unload Me
End Sub

Private Sub lstTables_DblClick()
  On Error GoTo GTDErr
  
  Screen.MousePointer = vbHourglass
  gdbCurrentDB.TableDefs(Trim$(Left$(lstTables.Text, InStr(lstTables.Text, vbTab)))).RefreshLink
  Screen.MousePointer = vbDefault
  Exit Sub
  
GTDErr:
  ShowError
'  Resume 'x
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
  
  lstTables.Width = Me.ScaleWidth - (lstTables.Left * 2)
  lstTables.Height = Me.ScaleHeight - (picButtons.Height + 40)
End Sub

Public Sub AddAttachment()
  On Error GoTo AttachErr
  
  Dim sConnect As String
  Dim tbl As TableDef
  Dim i As Integer
  Dim sTmp As String

  With frmNewAttach

    If DupeTableName(.txtAttachName.Text) Then
      .txtAttachName.SetFocus
      Exit Sub
    End If
  
    'WAS: MsgBar "Attaching " & .txtAttachName.Text, True
    MsgBar LoadResString(S56_Attaching) & .txtAttachName.Text, True

    Screen.MousePointer = vbHourglass
    sConnect = .GetConnectStr()
    
    'set the properties
    Set tbl = gdbCurrentDB.CreateTableDef(.txtAttachName.Text)
    tbl.SourceTableName = .cboTableName.Text
    tbl.Connect = sConnect
    If .chkSavePassword.Value = vbChecked Then
      tbl.Attributes = dbAttachSavePWD
    End If
    If .chkExclusive.Value = vbChecked Then
      tbl.Attributes = tbl.Attributes Or dbAttachExclusive
    End If
    gdbCurrentDB.TableDefs.Append tbl
    
    'make sure and remove it if it was overwritten
    For i = 0 To lstTables.ListCount - 1
      sTmp = Trim$(Left$(lstTables.List(i), InStr(lstTables.List(i), vbTab)))
      If UCase(sTmp) = UCase(.txtAttachName.Text) Then
        lstTables.RemoveItem i
        Exit For
      End If
    Next
    'add it to the list
    lstTables.AddItem .txtAttachName.Text & String(32 - Len(.txtAttachName.Text), " ") & vbTab & .cboTableName.Text & "=>" & sConnect
  
    Screen.MousePointer = vbDefault
    .txtAttachName.Text = vbNullString
    .cboTableName.Text = vbNullString
  End With

  MsgBar vbNullString, False
  Screen.MousePointer = vbDefault
  Exit Sub

AttachErr:
  ShowError
'  Resume 'x
End Sub



'*********************************************************************************
'**          This Section Of Code Was Automatically Generated By ResMe          **
'**                                                                             **
'** String assignments to Constants have been converted to read-only properties **
'*********************************************************************************


'This was: Const FORMCAPTION = "Attachments"
Property Get FORMCAPTION As String
    'WAS: FORMCAPTION = "Attachments"
    FORMCAPTION = LoadResString(S59_Attachments)

End Property

'This was: Const BUTTON1 = "&New"
Property Get BUTTON1 As String
    'WAS: BUTTON1 = "&New"
    BUTTON1 = LoadResString(S332_New)

End Property

'This was: Const BUTTON2 = "&ReAttach"
Property Get BUTTON2 As String
    'WAS: BUTTON2 = "&ReAttach"
    BUTTON2 = LoadResString(S436_ReAttach)

End Property

'This was: Const BUTTON3 = "&Close"
Property Get BUTTON3 As String
    'WAS: BUTTON3 = "&Close"
    BUTTON3 = LoadResString(S94_Close)

End Property


Private Sub frmAttachments_Auto_Init()
'This routine initializes all User Interface control properties on frmAttachments.
'This section of code was automatically generated by the ResMe String Extraction Utility.
    'WAS: Me.Caption = "Attachments"
    Me.Caption = LoadResString(S59_Attachments)

    'WAS: cmdNew.Caption = "&New"
    cmdNew.Caption = LoadResString(S332_New)

    'WAS: cmdReAttach.Caption = "&ReAttach"
    cmdReAttach.Caption = LoadResString(S436_ReAttach)

    'WAS: cmdClose.Caption = "&Close"
    cmdClose.Caption = LoadResString(S94_Close)

End Sub