Option Compare Database
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function perekresni()


Dim i As Integer
DoCmd.SetWarnings False


For i = 1 To 6



DoCmd.RunSQL "SELECT [Модуль].[ИД] INTO [АААИД] IN 'C:\Users\Maxim\Desktop\Новая папка (2)\Данные.mdb' FROM [Модуль] WHERE ((([Модуль].[ИД])=" & i & "));"


DoCmd.RunSQL "SELECT [Модуль].[Дата] INTO [АААДАТА] IN 'C:\Users\Maxim\Desktop\Новая папка (2)\Данные.mdb' FROM [Модуль] WHERE ((([Модуль].[ИД])=" & i & "));"


DoCmd.RunSQL "SELECT [Модуль].[ЮрЛ] INTO [АААЮЛ] IN 'C:\Users\Maxim\Desktop\Новая папка (2)\Данные.mdb' FROM [Модуль] WHERE ((([Модуль].[ИД])=" & i & "));"


DoCmd.RunSQL "SELECT [Модуль].[ПолнАдр] INTO [ААААДР] IN 'C:\Users\Maxim\Desktop\Новая папка (2)\Данные.mdb' FROM [Модуль] WHERE ((([Модуль].[ИД])=" & i & "));"


DoCmd.RunSQL "SELECT [Модуль].[Sum-ПродРуб] AS [Сумма] INTO [АААСУМ] IN 'C:\Users\Maxim\Desktop\Новая папка (2)\Данные.mdb' FROM [Модуль] WHERE ((([Модуль].[ИД])=" & i & "));"


FileCopy "C:\Users\Maxim\Desktop\Акт.xlsx", "C:\Users\Maxim\Desktop\Акты\Акт_инкассации_№_" & i & ".xlsx"
freshlong ("C:\Users\Maxim\Desktop\Акты\Акт_инкассации_№_" & i & ".xlsx")


Next i


End Function


Function freshlong(b1 As String)
Dim book1 As Excel.Workbook
Dim sheet1 As Excel.Worksheet
Dim pt1 As Excel.PivotTable
Dim i, j As Integer
Set book1 = Excel.Workbooks.Open(b1)
For i = 1 To book1.Worksheets.Count
Set sheet1 = book1.Worksheets(i)
If sheet1.PivotTables.Count = 0 And (sheet1.Name Like "*служ*") = False Then
sheet1.ListObjects.Item(1).QueryTable.Refresh
Sleep (500)
End If
Next
For i = 1 To book1.Worksheets.Count
Set sheet1 = book1.Worksheets(i)
If sheet1.PivotTables.Count > 0 Then
For j = 1 To sheet1.PivotTables.Count
Set pt1 = sheet1.PivotTables(j)
pt1.RefreshTable
Sleep (500)
Next
End If
Next
Excel.Application.DisplayAlerts = False
book1.Close savechanges:=True
End Function