Обновить запрос для вставки отсутствующих дат в указанном диапазоне в таблице MS Access

У меня есть база данных Access, которая отслеживает текущее 35-секундное окно по данным о работе. У меня это автоматизировано, поэтому раз в месяц я запускаю скрипт, который генерирует электронную почту, и прикрепляет листок Excel для соответствующего менеджера программ, чтобы они могли обновлять прогнозы количества членов экипажа в течение следующих 35 недель. Программа сохраняет копию листа Excel, поэтому я могу выполнить сравнение после возврата листа.

То, что я хотел бы сделать, – добавить отсутствующие даты из их набора данных до создания листа Excel, который отправляется по электронной почте. Таким образом, таблица, в которой хранятся даты, будет иметь автоматически сгенерированный номер позиции, который я мог бы ссылаться позже, когда я повторно импортирую данные из файла Excel.

Я полагаю, что я мог бы просто запустить запрос на обновление, который расширяет все записи о работе в базе данных до одной и той же даты окончания и позже очистят все, что имеет нулевое количество членов экипажа, когда окно качения падает, но существует ли лучший способ приближаясь к этому?

Следующий код будет: 1. Добавить отсутствующие даты (но только в течение 4 недель с даты выполнения). 2. Добавить 35 новых «недельных» записей за прошлую дату

Этот код требует, чтобы ваш дизайн таблицы имел уникальный ключ Job_ID + WeekDate

Option Compare Database Option Explicit Dim dbs As DAO.Database Dim rsJobs As DAO.recordSet Dim rsWeek As DAO.recordSet Function Create_New_Weeks() Dim strSQL As String Dim i As Integer Dim dStartDate As Date Dim dEndDate As Date Dim dPriorMonday As Date Dim dTempDate As Date Dim strJobID As String Const iWksToAdd = 35 ' Change as desired On Error GoTo Error_Trap Set dbs = CurrentDb ' Get Job_ID and Week records for all OPEN Jobs. ' Expect this to possibly be the first date, possibly a gap in dates, then ' one or more weekly dates. strSQL = "SELECT tblProjects.Job_ID, tblProjects.DateEnded, tblJobWeeks.WorkWeek " & _ "FROM tblProjects INNER JOIN tblJobWeeks ON tblProjects.Job_ID = tblJobWeeks.Job_ID " & _ "WHERE (((tblProjects.DateEnded) Is Null)) " & _ "ORDER BY tblProjects.Job_ID, tblJobWeeks.WorkWeek;" Set rsJobs = dbs.OpenRecordset(strSQL) If rsJobs.EOF Then MsgBox "No Jobs found!", vbOKOnly + vbCritical, "No Jobs" GoTo Exit_Code Else rsJobs.MoveFirst End If ' First, find prior Monday's date as a baseline dPriorMonday = DateAdd("ww", -1, Date - (Weekday(Date, vbMonday) - 1)) ' Calculate +35 weeks -- and make sure the date will be a monday. If Weekday(Date, 1) = 2 Then dEndDate = DateAdd("ww", iWksToAdd, Date) Else dEndDate = DateAdd("ww", iWksToAdd, dPriorMonday) End If ' Open the 'Weekly' table for inserting 35 new records, plus missing dates strSQL = "select * from tblJobWeeks order by Job_ID, WorkWeek" Set rsWeek = dbs.OpenRecordset(strSQL) ' FYI: It doesn't make sense to add records between the 'start' date and + 35 weeks, then ' have your monthly process delete empty ones from prior months. ' This code will only add missing records going back 4 weeks. ' Your notes indicated there would be at least two records for any given Job. If that is ' not correct, this code may not work! ' Save the starting point strJobID = rsJobs!Job_ID dTempDate = rsJobs!WorkWeek Do While Not rsJobs.EOF Debug.Print "Job: " & rsJobs!Job_ID & vbTab & "First Date: " & rsJobs!WorkWeek & vbTab & "W/E: " & rsJobs!WorkWeek If strJobID <> rsJobs!Job_ID Then ' We have changed to a NEW Job_ID ' Fill the +35 weeks ' Only add prior 4 wks , then +35 If dTempDate < dEndDate Then dTempDate = DateAdd("ww", -3, dPriorMonday) ' Get date from 3 or 4 weeks back. Do If dTempDate < dEndDate Then ' Don't add dates over 4 weeks old - Remove this if necessary If dTempDate >= DateAdd("ww", -4, Date) Then Debug.Print "Insert ID: " & strJobID & vbTab & dTempDate Add_Week strJobID, dTempDate Else Debug.Print "Skip - Older than 4 weeks: " & vbTab & dTempDate End If dTempDate = DateAdd("ww", 1, dTempDate) Else Exit Do End If Loop strJobID = rsJobs!Job_ID dTempDate = DateAdd("ww", 1, rsJobs!WorkWeek) ' Should be the FIRST date for this Job Else If rsJobs!WorkWeek = dTempDate Then dTempDate = DateAdd("ww", 1, dTempDate) Else ' Don't add dates over 4 weeks old - Remove this if necessary If dTempDate > DateAdd("ww", -4, Date) Then Debug.Print "Insert ID: " & strJobID & vbTab & dTempDate Add_Week strJobID, dTempDate Else Debug.Print "Skip - Older than 4 weeks: " & vbTab & dTempDate End If dTempDate = DateAdd("ww", 1, dTempDate) End If End If rsJobs.MoveNext Loop 'Check if last ID has +35 dates If dTempDate < dEndDate Then Do Until dEndDate = dTempDate ' Don't add dates over 4 weeks old - Remove this if necessary If dTempDate > DateAdd("ww", -4, Date) Then Debug.Print "Insert ID: " & strJobID & vbTab & dTempDate Add_Week strJobID, dTempDate Else Debug.Print "Skip - Older than 4 weeks: " & vbTab & dTempDate End If dTempDate = DateAdd("ww", 1, dTempDate) Loop End If Exit_Code: If Not rsJobs Is Nothing Then rsJobs.Close Set rsJobs = Nothing End If If Not rsWeek Is Nothing Then rsWeek.Close Set rsWeek = Nothing End If dbs.Close Set dbs = Nothing Exit Function Error_Trap: Debug.Print Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Weeks" ' If duplicate record, ignore If Err.Number = 3022 Then Resume Next End If MsgBox Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Weeks" Create_New_Weeks = "Error: " & Err.Number & vbTab & Err.Description & vbCrLf & "In: Create_New_Weeks" Resume Exit_Code Resume End Function Function Add_Week(strID As String, dDate As Date) With rsWeek .AddNew !Job_ID = strID !WorkWeek = dDate !Crew_Num = 0 .Update End With End Function 
  • SQL db поиск по каждой строке в Excel
  • SSIS Как запускать одну и ту же хранимую процедуру с разными параметрами каждый раз
  • Вытягивание данных с вкладки листа Excel в SQL Server
  • Максимальное значение SUM «N» в запросе excel sql
  • SQL OPENROWSET с Excel
  • Excel Отключение ведущих нулей в представлении
  • Форматирование результатов в SQL Server 2012 или Excel 2013
  • Сохранять заголовок / имя столбца при преобразовании файла Excel в файл SQL
  • Вставка SQL с использованием файла Excel
  • Код Excel для SQL: не удается найти столбец 8 Ошибка
  • SQL извлекает данные в Excel с помощью Powershell
  • Interesting Posts

    Использование символов Unicode в имени серии Excel с использованием VBA

    Excel Visualbasic Переместите часть строки во вторую строку

    Сумма массива Excel с несколькими условиями на основе именованного диапазона

    Обновить сводную таблицу с помощью Apache POI

    Как рассчитать время остановки

    Копирование данных из столбца в другой лист – VBA в Excel

    Что я использую для отображения CSV-данных в виде графика?

    VBA смотреть вниз столбца в Excel и найти значение?

    VBA Batch Action on Folder – списки CSV для заполнения шаблона XLS

    Excel 2010 выбирает каждую ячейку в строке, активирует ее по очереди

    «Требуемый объем времени выполнения Excel VBA« Требуемый объект 424 »продолжает появляться с перерывами

    Как выполнить от 0 до 1 Нормализация в excel

    Не знаю, как читать файл данных python-excel

    Как мне изменить этот код, чтобы вставить строку в последней строке с данными?

    Excel и VBA Crashing Midway Through Macro

    Давайте будем гением компьютера.