powered by simpleCommunicator - 2.0.58     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / MS Project VBA
2 сообщений из 2, страница 1 из 1
MS Project VBA
    #38309211
AleKs20
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Всем привет!!! Недавно столкнулся с такой проблемой, что не мог подтянуть значения с sql базы в ms project...
Я облазил кучу форумов, но ничего интересного так и не нашел... Задачу в итоге я сделал и вот решил выкинуть сюда, может кому и пригодится)

Хронимка на ms sql server 2005:


set ANSI_NULLS ON
set QUOTED_IDENTIFIER ON
go

ALTER PROCEDURE [dbo].[AGRRpt_StaffTasks]

AS
BEGIN
SET NOCOUNT ON;
DECLARE @Start as datetime
set @Start= GetDate()
select TOP 1000 TASK.TASKID,'' as Fio,Place.PlaceName as PlaceCode,
(case isnull(Part.ProductId,0) when 0 then Part.PartName else Product.ProductName end ) as PartName,
Task.TaskName,
Task.StartDateTime,Task.FinishDateTime,PT1.Shift as Shift1,PT2.Shift as Shift2,
isnull(Part.PartVolume,'') as Kol,
(case year(Task.StartDateTime) when year(@Start) then
(case month(Task.StartDateTime) when month(@Start) then
(case day(Task.StartDateTime) when day(@Start) then
(case PT1.Shift when 1 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Zap1,
(case year(Task.FinishDateTime) when year(@Start) then
(case month(Task.FinishDateTime) when month(@Start) then
(case day(Task.FinishDateTime) when day(@Start) then
(case PT2.Shift when 1 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Sd1,
(case year(Task.StartDateTime) when year(@Start) then
(case month(Task.StartDateTime) when month(@Start) then
(case day(Task.StartDateTime) when day(@Start) then
(case PT1.Shift when 2 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Zap2,
(case year(Task.FinishDateTime) when year(@Start) then
(case month(Task.FinishDateTime) when month(@Start) then
(case day(Task.FinishDateTime) when day(@Start) then
(case PT2.Shift when 2 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Sd2,
(case year(Task.StartDateTime) when year(@Start) then
(case month(Task.StartDateTime) when month(@Start) then
(case day(Task.StartDateTime) when day(@Start) then
(case PT1.Shift when 3 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Zap3,
(case year(Task.FinishDateTime) when year(@Start) then
(case month(Task.FinishDateTime) when month(@Start) then
(case day(Task.FinishDateTime) when day(@Start) then
(case PT2.Shift when 3 then isnull(Part.PartVolume,0) else 0 end)
else 0 end) else 0 end ) else 0 end) as Sd3
from PlanTask AS Task
left join PlanPart as Part on Task.PartId=Part.PartId
left join PlanProduct as Product on Part.ProductId=Product.ProductId
left join PlanPlace as Place on Task.PlaceId=Place.PlaceId
left join PlanTime AS PT1 on Task.StartDateTime>PT1.StartDateTime and Task.StartDateTime<=PT1.FinishDateTime
left join PlanTime AS PT2 on Task.FinishDateTime>PT2.StartDateTime and Task.FinishDateTime<=PT2.FinishDateTime
where (Task.StateId is null or Task.StateId=30)
and ((year(Task.StartDateTime)=year(GetDate())
and month(Task.StartDateTime)=month(GetDate())
and day(Task.StartDateTime)=day(GetDate()))
or (year(Task.FinishDateTime)=year(GetDate())
and month(Task.FinishDateTime)=month(GetDate())
and day(Task.FinishDateTime)=day(GetDate())))
and right(Task.TaskName,4)='_032'

ORDER BY Place.PlaceTechId,Task.StartDateTime,Task.FinishDateTime


END




Сам макрос в ms project:


Sub SQLUpdate()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Создаем переменные
'SQL
Dim cSQLSrv As String
Dim cSQLUsr As String
Dim cSQLPwd As String
Dim cSQLDB As String
Dim cSQLWID As String
Dim cSQLApp As String
Dim sSQLQry As String
Dim GRRpt_StaffTasks As String

'ADODB
Dim cConStr As String
Dim oCon As ADODB.Connection
Dim oCmd As ADODB.Command
Dim oRec As ADODB.Recordset

'Project
Dim iRow As String
Dim oTask As Task
Dim r As String


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Получаем данные с SQL сервера
'Подключаемся к SQL серверу
cSQLSrv = "SQL сервер"
cSQLUsr = "Логин"
cSQLPwd = "Пароль"
cSQLDB = "Ваша база"
cSQLWID = Application.UserName
cSQLApp = Application.Name



cConStr = "Provider = SQLOLEDB;" + _
"Password = " + cSQLPwd + ";" + _
"User ID=" + cSQLUsr + ";" + _
"Initial Catalog=" + cSQLDB + ";" + _
"Data Source=...;"

Set oCon = CreateObject("ADODB.Connection")
oCon.ConnectionString = cConStr
oCon.Open



Set oCmd = CreateObject("ADODB.Command")
oCmd.ActiveConnection = oCon
oCmd.CommandType = adCmdText
oCmd.CommandText = "dbo.AGRRpt_StaffTasks"
Set oRec = oCmd.Execute

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Заполняем документ
iRow = 0
Do Until oRec.EOF
iRow = iRow + 1

'Добавляем задачу
Set oTask = ActiveProject.Tasks.Add(oRec.Fields("TaskName").Value)
'Устанавливаем сроки
oTask.ResourceNames = oRec.Fields("PlaceCode").Value
oTask.Text1 = oRec.Fields("PartName")
oTask.Start = oRec.Fields("StartDateTime").Value
oTask.Finish = oRec.Fields("FinishDateTime").Value

Set oTask = Nothing
oRec.MoveNext
Loop

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Финиш
Set oCmd = Nothing
Set oRec = Nothing
Set oCon = Nothing

End Sub

Заполняет строки на ура...
...
Рейтинг: 0 / 0
MS Project VBA
    #38309242
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AleKs20выкинуть сюда может кому и пригодитсячтобы это кому-то действительно пригодилось, стоило бы не "выкинуть", а придумать соответствующий заголовок темы, чтобы хоть кто-то мог ее найти, а также, как я уже просил, прочитать FAQ и правильно оформить выложенный код (с тэками SQL и VB)
...
Рейтинг: 0 / 0
2 сообщений из 2, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / MS Project VBA
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]