Sub savezakazxls()

On Error GoTo err
  Dim strZakaz As String, curDate
  curDate = "010101"
  curName = "Заказ_" & curDate
  curTable = curName & ".xls"
  strNewBase = App.Path & "\Data\" & curTable
  strZakazNeedFound = Dir(strNewBase)
  If UCase(strZakazNeedFound) = UCase(curTable) Then
     Kill strNewBase
  End If
  Set cnn = CreateObject("ADODB.Connection")
  cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strNewBase
  cnn.Properties("Extended Properties").Value = "Excel 8.0"
  cnn.Open
  
  cnn.Execute "CREATE TABLE " & curName & " (Name char(50), code_f char(30), code_l char(30), code_or char(30)," & _
        "code_a1 char(30), firma char(25), kol_vo char(4),cena char(10), summa char(50),valuta char(4))"
  If zakazgd.Rows <  2  Then
      Exit Sub
  End If
  For i =  1  To zakazgd.Rows -  1 
   nname = zakazgd.TextMatrix(i,  1 )       '= Наименование
 
   ncode = zakazgd.TextMatrix(i,  2 )       '= Код фирмы
 
   ncode_l = zakazgd.TextMatrix(i,  3 )     '= Код лидирующий
 
   ncode_or = zakazgd.TextMatrix(i,  4 )    '= Код оригинальный
 
   ncode_a1 = zakazgd.TextMatrix(i,  5 )    '= Альтернативный
 
   nfirma = zakazgd.TextMatrix(i,  6 )      '= Фирма
 
   nkol_vo = zakazgd.TextMatrix(i,  7 )     '= Кол-во
 
   ncena = zakazgd.TextMatrix(i,  9 )       '= Цена
 
   nsumma = zakazgd.TextMatrix(i,  10 )     '= Сумма
 
   nvaluta = zakazgd.TextMatrix(i,  17 )    '= Валюта
 
   cnn.Execute "INSERT INTO " & curName & " VALUES ('" & nname & "', '" & ncode & "', '" & ncode_l & "', '" & ncode_or & "','" & ncode_a1 & "', '" & nfirma & "', '" & nkol_vo & "', '" & ncena & "', '" & nsumma & "','" & nvaluta & "')"


  Next
  cnn.Close

  MsgBox "Запись завершена", , "Сохранение"
exSub:
  Exit Sub
err:
  MsgBox "Ошибка сохранения !!!" & vbCr & vbCr & Error, vbCritical, "Сохранение"
End Sub