#vba #ms-access
#vba #ms-access
Вопрос:
циклы останавливаются на другой части инструкции if .. в противном случае работает отлично. Что делает код, так это проверяет, включен ли список сотрудников из отдела в расписание (день 1 диапазона дат. затем 2-й день диапазона дат и так далее. поэтому, если записи не найдены, код добавляет весь список сотрудников за каждый день диапазона дат (выбранный пользователем). Моя проблема возникает, когда 1 сотрудник уже включен в расписание, тогда все циклы останавливаются.
Private Sub Command37_Click()
On Error Resume Next
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strPrompt As String
Dim str2Prompt As String
Dim str3Prompt As String
Dim startd As String
Dim endd As String
strPrompt = InputBox("Enter date to copy")
str2Prompt = InputBox("Enter Start Date")
str3Prompt = InputBox("Enter End Date")
str3Prompt = DateAdd("d", 1, str3Prompt)
'trying this
While DateDiff("d", str2Prompt, str3Prompt) > 0
strSQL = "SELECT Employee.[Employee] FROM Employee WHERE Class ='" amp; Me.Text0 amp; "' AND Active = -1"
Set rst = CurrentDb.OpenRecordset(strSQL)
Dim existrste As String
Dim sqlexist As String
With rst
Do While Not .EOF
say = rst![Employee]
'MsgBox say
'see if exist
sqlexist = "SELECT Employee FROM [Daily Report] WHERE FORMAT([Start Shift],'Short Date') ='" amp; str2Prompt amp; "' AND Employee ='" amp; say amp; "'"
DoCmd.RunSQL sqlexist
Set rste = CurrentDb.OpenRecordset(sqlexist)
existrste = rste![Employee]
If existrste = "" Then
Dim Nendd As Date
'MsgBox "Insert" amp; say
'select from dailyreport where date is userinput date to copy
stgcopy = "SELECT * FROM [Daily Report] WHERE format([Start Shift],'Short Date') ='" amp; strPrompt amp; "' AND Employee ='" amp; say amp; "'"
DoCmd.RunSQL stgcopy
Set rstc = CurrentDb.OpenRecordset(stgcopy)
'end time format
endd = rstc![End Shift]
enddt = TimeValue(endd)
Nendd = str2Prompt amp; " " amp; enddt
'start time format
sd = rstc![Start Shift]
sdt = TimeValue(sd)
Nsd = str2Prompt amp; " " amp; sdt
'class
clss = rstc![Class]
'billable
bill = rstc![Billable]
'status
sta = rstc![Status]
'Company
Comp = rstc![Company]
'Lease
Leas = rstc![Lease]
'Well
Well = rstc![Well]
'dont include transfer
tran = rstc![Transfer]
DoCmd.SetWarnings False
SQLINSERT = "INSERT INTO `Daily Report` (`Employee`,`Class`,`Start Shift`,`End Shift`,`Billable`,`Status`,`Company`,`Lease`,`Well`) Values('" amp; say amp; "','" amp; clss amp; "','" amp; Nsd amp; "','" amp; Nendd amp; "','" amp; bill amp; "','" amp; sta amp; "','" amp; Comp amp; "','" amp; Leas amp; "','" amp; Well amp; "') "
DoCmd.RunSQL SQLINSERT
'rstc.MoveNext
DoCmd.SetWarnings True
MsgBox str2Prompt
Else
End If
rst.MoveNext
Loop
'trying this
str2Prompt = DateAdd("d", 1, str2Prompt)
rst.Close
'Make sure you close the recordset...
End With
Wend
End Sub
Комментарии:
1. Почему у вас вообще есть
elseif, если он ничего не делает?2. Достигло ли оно EOF?
3. RunSQL бесполезен для запроса SELECT, только для операторов SQL action. Эта строка не делает ничего продуктивного. Разрешаете ли вы пустую строку в текстовых полях? Если поле Employee пустое, это пустая строка или это Null? Вы отладили шаг?
4. paxdiable — если данные существуют на эту дату для этого сотрудника, тогда ничего не делайте и пропустите insert
5. braX — он не достиг EOF, он остановил цикл, как только нашел данные о дате для сотрудника
Ответ №1:
Я думаю, вам нужно что-то вроде этого (воздушный код):
Private Sub Command37_Click()
On Error Resume Next
Dim rst As DAO.Recordset
Dim strSQL As String
Dim Prompt1 As Date
Dim Prompt2 As Date
Dim Prompt3 As Date
Dim Nendd As Date
Dim Nsd As Date
Dim clss As String
Dim sta As String
Dim comp As String
Dim leas As String
Dim well As String
Dim existrste As Boolean
Dim sqlexist As String
Prompt1 = DateValue(InputBox("Enter date to copy"))
Prompt2 = DateValue(InputBox("Enter Start Date"))
Prompt3 = DateValue(InputBox("Enter End Date"))
Prompt3 = DateAdd("d", 1, Prompt3)
While DateDiff("d", Prompt2, Prompt3) > 0
strSQL = "SELECT Employee.[Employee] FROM Employee WHERE Class ='" amp; Me!Text0.Value amp; "' AND Active = -1"
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
Do While Not .EOF
say = rst![Employee].Value
'MsgBox say
'see if exist
sqlexist = "SELECT Employee FROM [Daily Report] WHERE Fix([Start Shift]) = #" amp; Format(Prompt2, "yyyy/mm/dd") amp; "" AND Employee ='" amp; say amp; "'"
Set rste = CurrentDb.OpenRecordset(sqlexist)
existrste = CBool(rste.RecordCount)
If Not existrste Then
'MsgBox "Insert" amp; say
'select from dailyreport where date is userinput date to copy
stgcopy = "SELECT * FROM [Daily Report] WHERE Fix([Start Shift]) =#" amp; Format(Prompt1, "yyyy/mm/dd") amp; "" AND Employee ='" amp; say amp; "'"
Set rstc = CurrentDb.OpenRecordset(stgcopy)
Nendd = Prompt2 TimeValue(rstc![End Shift].Value)
Nsd = Prompt2 TimeValue(rstc![Start Shift].Value)
'class
clss = rstc![Class].Value
'billable
bill = rstc![Billable].Value
'status
sta = rstc![Status].Value
'Company
Comp = rstc![Company].Value
'Lease
Leas = rstc![Lease].Value
'Well
Well = rstc![Well].Value
rstc.AddNew
rstc!Employee.Value = say
rstc![Class].Value = clss
rstc![Start Shift].Value = Nsd
rstc![End Shift].Value = neendd
rstc!Billable.Value = bill
rstc![Status].Value = sta
rstc!Company.Value = Comp
rstc!Lease.Value = Leas
rstc!Well.Value = Well
rstc.Update
MsgBox Prompt2
End If
rst.MoveNext
Loop
Prompt2 = DateAdd("d", 1, Prompt2)
End With
rst.Close
Wend
End Sub