Indy Send ANd Receive E-mail No.2

I am using the following procedure to store an email received with Indy.
Some times the Attachment ( when it is an Inline Image ) does not save to my
specified area.  any ideas where I am going wrong??

Thanks

Lee

procedure TForm1.SaveMessage(Sender: Tobject);

Var
  nParts,x,y: Integer;
  Id: Integer;
  Body,Html: TstringList;
  Cid: String;

Begin
  Body     := TstringList.Create;
  Html     := TstringList.Create;

  Randomize;
  Id := Random(999999999999);
  Table3.IndexName := 'Id';
  While Table3.FindKey([id]) = True Do Begin
    Randomize;
    Id := Random(999999999999);
  End;

  nParts := Received1.MessageParts.Count;
  For x := 0 To (nParts-1) Do BEgin
    If Received1.MessageParts.Items[x] is TIdText then Begin
      If Pos('TEXT/HTML',UpperCase(Received1.MessageParts.Items
[x].ContentType)) > 0 Then Html.AddStrings(
TIdText(Received1.MessageParts.Items[x]).Body );
      If
Pos('TEXT/PLAIN',UpperCase(Received1.MessageParts.Items[x].ContentType)) > 0
Then Body.AddStrings( TIdText(Received1.MessageParts.Items[x]).Body );
    End;
  End;
  Table3.Active    := False;
  Table3.IndexName := 'Id';
  Table3.Active    := True;
  Table3.Append;
  Table3.FieldByName('Id').ASInteger := Id;
  Table3.FieldByName('FromMail').ASString := Received1.From.Address;
  Table3.FieldByName('FromName').ASString := Received1.From.Name;
  Table3.FieldByName('Display').ASString  := Received1.From.Text;
  Table3.FieldByName('To').ASString       :=
Received1.Recipients.Items[0].Text;
  Table3.FieldByName('Subject').ASString  := Received1.Subject;
  Table3.FieldByName('DateRec').ASDateTime := Now;
  Table3.FieldByName('Body').ASString := Body.Text;
  Table3.FieldByName('HtmlBody').ASString := Html.Text;
  Table3.Post;
  Table3.Active    := False;
  Table3.IndexName := 'Id';
  Table3.Active    := True;
  Table3.First;

  For x := 0 To (nParts-1) Do BEgin
    If Received1.MessageParts.Items[x] is TIdAttachMent then Begin

TIdAttachment(Received1.MessageParts.Items[x]).SaveToFile('.\Attached\'+TIdA
ttachment(Received1.MessageParts.Items[x]).FileName);
      Table4.Append;
      Table4.FieldByName('Id').AsInteger := Id;
      Table4.FieldByName('FileName').ASString :=
'.\Attached\'+TIdAttachment(Received1.MessageParts.Items[x]).FileName;
      For y := 0 To
(TIdAttachment(Received1.MessageParts.Items[x]).Headers.Count -1) Do Begin
        If Copy(
UpperCase(TIdAttachment(Received1.MessageParts.Items[x]).Headers.Strings[y])
,1,11) = 'CONTENT-ID:' Then BEgin
          cId :=
Copy(Trim(TIdAttachment(Received1.MessageParts.Items[x]).Headers.Strings[y])
,12,255);
          Table4.FieldByName('ContentId').ASString := cId;
        End;
      End;

      Table4.Post;
      Table4.Active := False;
      Table4.IndexName := 'Id';
      Table4.Active := True;
    End;
  End;

End;