Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Private Sub AFOperations(Operation As String)
- Dim TempFileName As String
- Dim qAF As rdoQuery
- Dim rsAF As rdoResultset
- Dim str As String
- Dim fSize As Long
- Dim DocWordEdit_Id As Long
- Dim Response
- Dim RetValue As Long
- strSQL = "SELECT * FROM AttachFiles WHERE Doc_ID=? AND A_ID=?"
- Set qAF = rdoCn.CreateQuery("", strSQL)
- qAF.rdoParameters(0) = EmailID
- qAF.rdoParameters(1) = -1
- Set rsAF = qAF.OpenResultset(rdOpenDynamic, rdConcurRowVer)
- Select Case Operation
- Case "Blanc VBF"
- ShellExecute Me.hwnd, "open", "s:\DocFlow\Новые бланки\vbf.doc", 0, 0, SW_SHOWMAXIMIZED
- 'ShellExecute Me.hwnd, "open", "s:\docflow\vbf.doc", 0, 0, SW_SHOWMAXIMIZED
- Case "Blanc VBC"
- ShellExecute Me.hwnd, "open", "s:\DocFlow\Новые бланки\vbc.doc", 0, 0, SW_SHOWMAXIMIZED
- 'ShellExecute Me.hwnd, "open", "s:\docflow\vbc.doc", 0, 0, SW_SHOWMAXIMIZED
- Case "Load"
- MsgBox "1. При прикреплении файла проследите, чтобы внизу документа было 5-7 пустых строк" & vbNewLine & " для правильного прикрепления подписи согласующего (используйте непечатаемые знаки)" & vbNewLine & "" & vbNewLine & "2. Не вводите наименование должности и фамилию согласующего!" & vbNewLine & " Заполнение происходит автоматически при прикреплении подписи" & vbNewLine & "" & vbNewLine & "3. Для создания новых документов используйте бланки для ВПК и ВПЗ нового образца!", vbInformation Or vbOKOnly, "Внимание!!!"
- cdFile.FileName = ""
- cdFile.InitDir = "s:\docflow\Новые бланки\"
- cdFile.ShowOpen
- If Len(cdFile.FileName) > 0 Then
- str = InputBox("Описание файла", "Присоединить файл")
- Me.MousePointer = vbHourglass
- With rsAF
- .AddNew
- !Doc_ID = EmailID
- !a_id = -1
- !Name = cdFile.FileTitle
- !FilePath = Left(cdFile.FileName, Len(cdFile.FileName) - Len(cdFile.FileTitle))
- !order_n = 1
- !Description = str
- ' NewFN = AddToFileUserSign "sd"
- ' AddToFileUserSign "sdddsd"
- SaveFileToDB cdFile.FileName, !FileBody, !Body_Size
- ' SaveFileToDB AddToFileUserSign(cdFile.FileName, "Razrabotka"), !FileBody, !Body_Size Инф о разработчике не нужна!
- .Update
- End With
- If EMMode = EMOpen Then
- EMMode = EMEdit
- End If
- GetEMailAttachFiles
- Me.MousePointer = vbDefault
- End If
- Case "Delete"
- Response = MsgBox("Вы уверены, что хотите удалить подключенный файл?", vbYesNo + vbQuestion + vbDefaultButton2)
- If Response = vbYes Then
- If lvAttachFiles.ListItems.Count > 0 Then
- qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
- Me.MousePointer = vbHourglass
- With rsAF
- .Requery
- .MoveFirst
- .Delete
- End With
- If EMMode = EMOpen Then
- EMMode = EMEdit
- End If
- GetEMailAttachFiles
- Me.MousePointer = vbDefault
- End If
- End If
- Case "Preview"
- If lvAttachFiles.ListItems.Count > 0 Then
- TempFileName = String(1024, " ")
- GetTempFileName TempDirectory, "doc", 0, TempFileName
- TempFileName = CreateTempFile("doc") & Right(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text, Len(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text) + 1 - InStrRev(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text, ".", , vbBinaryCompare)) ' ".doc"
- ReDim Preserve TempFiles(UBound(TempFiles) + 1)
- TempFiles(UBound(TempFiles)) = TempFileName
- If Len(TempFileName) > 0 Then
- qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
- Me.MousePointer = vbHourglass
- With rsAF
- .Requery
- .MoveFirst
- fSize = !Body_Size
- LoadFileFromDB TempFileName, !FileBody, fSize
- End With
- Me.MousePointer = vbDefault
- TempFileName = Trim(TempFileName)
- ShellExecute Me.hwnd, "open", TempFileName, 0, 0, SW_SHOWMAXIMIZED
- End If
- End If
- Case "Edit"
- If lvAttachFiles.ListItems.Count > 0 Then
- TempFileName = String(1024, " ")
- GetTempFileName TempDirectory, "doc", 0, TempFileName
- TempFileName = CreateTempFile("doc") & Right(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text, Len(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text) + 1 - InStrRev(lvAttachFiles.ListItems(lvAttachFiles.SelectedItem.Index).Text, ".", , vbBinaryCompare)) ' ".doc"
- ReDim Preserve TempFiles(UBound(TempFiles) + 1)
- TempFiles(UBound(TempFiles)) = TempFileName
- On Error GoTo err
- If Len(TempFileName) > 0 Then
- qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
- Me.MousePointer = vbHourglass
- With rsAF
- .Requery
- .MoveFirst
- fSize = !Body_Size
- LoadFileFromDB TempFileName, !FileBody, fSize
- End With
- Me.MousePointer = vbDefault
- TempFileName = Trim$(TempFileName)
- Dim AppWord As Word.Application
- Dim DocWord As Word.Document
- Set AppWord = New Word.Application
- Set DocWord = AppWord.Documents.Open(TempFileName)
- AppWord.Visible = True
- 'ShellExecute Me.hwnd, "open", TempFileName, 0, 0, SW_SHOWMAXIMIZED
- Select Case MsgBox("После того, как Вы закончите редактирование и закроете WORD," & vbNewLine & " нажмите OK чтобы сохранить файл," & vbNewLine & " или ОТМЕНА, чтобы не сохранять его", vbInformation Or vbOKCancel, "Ожидаю ответа")
- Case vbOK
- Dim qAFE As rdoQuery
- Dim rsAFE As rdoResultset
- On Error GoTo ErrS
- strSQL = "SELECT * FROM AttachFiles WHERE Doc_ID=? AND A_ID=?"
- Set qAFE = rdoCn.CreateQuery("", strSQL)
- qAFE.rdoParameters(0) = EmailID
- qAFE.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
- Set rsAFE = qAFE.OpenResultset(rdOpenDynamic, rdConcurRowVer)
- With rsAFE
- .MoveFirst
- .Edit
- SaveFileToDB TempFileName, !FileBody, !Body_Size
- .Update
- End With
- EMailChange = True
- EMMode = LEdit
- rsAFE.Close
- Set rsAFE = Nothing
- qAFE.Close
- Set qAFE = Nothing
- DocWordEdit_Id = 0
- GetEMailAttachFiles
- Case vbCancel
- Set DocWord = Nothing
- Set AppWord = Nothing
- End Select
- End If
- End If
- End Select
- err:
- rsAF.Close
- Set rsAF = Nothing
- qAF.Close
- Set qAF = Nothing
- BuildToolBar
- Exit Sub
- ErrS:
- rsAFE.Close
- Set rsAFE = Nothing
- qAFE.Close
- Set qAFE = Nothing
- Set DocWord = Nothing
- Set AppWord = Nothing
- DocWordEdit_Id = 0
- MsgBox "Не удалось сохранить файл" & vbNewLine & err.Number & ": " & err.Description, vbExclamation Or vbOKOnly
- End Sub
Add Comment
Please, Sign In to add comment