Option Explicit
 Dim Doc As DOMDocument60


Private Sub cmdAdd_Click()
    Dim xmlEl As IXMLDOMElement
    Dim strFamily As String
    Dim strDiag As String
    Dim dtBirth As Date
    Dim dtPost As Date
    Dim intPalat As Integer
    Dim strOtdel As String
    Dim intKolDays As String
    On Error Resume Next
    If Doc Is Nothing Then
      Doc.Load App.Path & "\Card.xml"
        If Doc.parseError.errorCode <>  0  Then
          MsgBox Doc.parseError.reason, vbCritical, "Error in XML load"
        End If
      'MsgBox "Ошибка загрузки файла", vbCritical, "Аптекарь"
      'Exit Sub
    End If
    
    strFamily = CStr(txtFamily.Text)
    strDiag = CStr(txtDiag.Text)
    dtBirth = DTPicker1.Value
    dtPost = DTPicker2.Value
      If (dtBirth = dtPost) Then
        MsgBox "Вы что гоните товарищи", vbCritical, "Аптекарь"
        Exit Sub
      End If
    intPalat = CInt(txtNumRoom.Text)
    intKolDays = CInt(txtDays.Text)
    strOtdel = CStr(txtOtdl.Text)
    ' проверим все поля что бы не плодить фигню и пустые записи
       If (strFamily = "") Then
          MsgBox "Введены не все данные", vbCritical
          Exit Sub
       Else
          'создаем соотвествующую запись о нашем больном
          Set xmlEl = Doc.createElement("seek")
          Doc.documentElement.appendChild xmlEl
          'теперь проставим ему атрибуты кто что чего и куда
          Doc.documentElement.setAttribute "family", strFamily
          Doc.documentElement.setAttribute "diagnoz", strDiag
          Doc.documentElement.setAttribute "DateOfBirth", dtBirth
          Doc.documentElement.setAttribute "DateOfPost", dtPost
          Doc.documentElement.setAttribute "NumberOfPalat", intPalat
          Doc.documentElement.setAttribute "Otdel", strOtdel
          Doc.documentElement.setAttribute "DaysInKlinik", intKolDays
          Doc.save App.Path & "\Card.xml"
          Exit Sub
       End If
       
Err:
  MsgBox Err.Number & Err.Description, vbCritical
End Sub

Private Sub Form_Load()
    Dim strFail As String
    Dim strToLoad As String
    
    strFail = App.Path & "\Card.xml"
    strToLoad = "<?xml version=""1.0""?><rows></rows>"
    'неохота парится и писать проверку на существование файла поэтому сделаем проще
    On Error GoTo ErrHandler
    Set Doc = New DOMDocument60
    Doc.async = False 'отключение асинхронной загрузки
    Doc.validateOnParse = False 'отключение проверки схем
    Doc.Load App.Path & "\Card.xml"
    Exit Sub
ErrHandler:
    Set Doc = New DOMDocument60
    Doc.async = False 'отключение асинхронной загрузки
    Doc.validateOnParse = False 'отключение проверки схем
    
    Doc.loadXML strToLoad
    Doc.save App.Path & "\Card.xml"
    If Doc.parseError.errorCode <>  0  Then
        MsgBox Doc.parseError.reason, vbCritical, "Error in XML load"
    Else
        MsgBox "Документ удачно загружен", vbInformation
    End If
Err:
    MsgBox Err.Number & Err.Description, vbCritical
End Sub