Форумы HiProg.com - MS ACCESS, VBA, VB

 

Ответить на сообщение

Вернуться к теме

Вы отвечаете на сообщение:

ник: П.Полиграфович
Вот. Процедура более чем незамысловатая. Я пробовал вместо тела ставить Msgbox просто, работает, иначе сбоит!

Option Compare Database
Option Explicit
Public Sub WRITEOFF()
Dim RST As DAO.Recordset, strSQL As String, DELstr As String
  Set RST = CurrentDb.OpenRecordset("SELECT Round([Сумма]/[Кол-во дней]) AS INKASSO, " & _
  "Заказы.ClientID, [Заказы-detail].VisitDate, Группы.Группа FROM Группы INNER JOIN " & _
  "(Заказы INNER JOIN [Заказы-detail] ON Заказы.Код_Заказы = [Заказы-detail].OrderCode)" & _
  " ON Группы.Код = Заказы.Группа WHERE ((([Заказы-detail].VisitDate) = Date()))" & _
  "ORDER BY Round([Сумма]/[Кол-во дней])")
     If RST.RecordCount <> 0 Then
     With RST
       Do While Not .EOF
      DELstr = "DELETE FROM [Счета] WHERE Клиент = " & .Fields(1) & " AND " & _
      "Дата = " & Format(.Fields(2), "\#mm\/dd\/yyyy\#") & " AND Инкассо = " & .Fields(0) & " " & _
      " AND Описание = '" & "Списание" & .Fields(3) & "';"
        CurrentProject.Connection.Execute DELstr
      strSQL = "INSERT INTO [Счета]([Клиент],[Дата],[Инкассо], " & _
         "[Описание]) VALUES (" & .Fields(1) & ", " & _
         "" & Format(.Fields(2), "\#mm\/dd\/yyyy\#") & ", " & .Fields(0) & ", " & _
         "'" & "Списание" & .Fields(3) & "');"
                  CurrentProject.Connection.Execute strSQL
          Debug.Print , .Fields(0), .Fields(1), .Fields(2), .Fields(3)
       .MoveNext
     Loop
     End With
     End If
   End Sub

В пошаговом работает. Работает без сбоев также в случае если модуль открыт.


Ваше имя:

Пароль:
Цитировать: [quote][/quote] Код: [code][/code]
Жирный: [b][/b] Наклонный: [i][/i]
URL: [url][/url] 

Сообщение:

 Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru

Прикрепить:

 

Для вставки смайлов в текст щелкните по значку.