daily pastebin goal
90%
SHARE
TWEET

Untitled

a guest Dec 11th, 2018 27 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Private Sub AFOperations(Operation As String)
  2. Dim TempFileName As String
  3. Dim qAF          As rdoQuery
  4. Dim rsAF         As rdoResultset
  5. Dim str          As String
  6. Dim fSize        As Long
  7. Dim DocWordEdit_Id As Long
  8. Dim Response
  9. Dim RetValue As Long
  10.     strSQL = "SELECT * FROM AttachFiles WHERE Doc_ID=? AND A_ID=?"
  11.     Set qAF = rdoCn.CreateQuery("", strSQL)
  12.     qAF.rdoParameters(0) = EmailID
  13.     qAF.rdoParameters(1) = -1
  14.     Set rsAF = qAF.OpenResultset(rdOpenDynamic, rdConcurRowVer)
  15.    
  16.     Select Case Operation
  17.         Case "Blanc VBF"
  18.         ShellExecute Me.hwnd, "open", "s:\DocFlow\Новые бланки\vbf.doc", 0, 0, SW_SHOWMAXIMIZED
  19.         'ShellExecute Me.hwnd, "open", "s:\docflow\vbf.doc", 0, 0, SW_SHOWMAXIMIZED
  20.        Case "Blanc VBC"
  21.         ShellExecute Me.hwnd, "open", "s:\DocFlow\Новые бланки\vbc.doc", 0, 0, SW_SHOWMAXIMIZED
  22.         'ShellExecute Me.hwnd, "open", "s:\docflow\vbc.doc", 0, 0, SW_SHOWMAXIMIZED
  23.        Case "Load"
  24.             MsgBox "1. При прикреплении файла проследите, чтобы внизу документа было 5-7 пустых строк" & vbNewLine & "    для правильного прикрепления подписи согласующего (используйте непечатаемые знаки)" & vbNewLine & "" & vbNewLine & "2. Не вводите наименование должности и фамилию согласующего!" & vbNewLine & "    Заполнение происходит автоматически при прикреплении подписи" & vbNewLine & "" & vbNewLine & "3. Для создания новых документов используйте бланки для ВПК и ВПЗ нового образца!", vbInformation Or vbOKOnly, "Внимание!!!"
  25.            
  26.             cdFile.FileName = ""
  27.             cdFile.InitDir = "s:\docflow\Новые бланки\"
  28.             cdFile.ShowOpen
  29.             If Len(cdFile.FileName) > 0 Then
  30.                 str = InputBox("Описание файла", "Присоединить файл")
  31.                 Me.MousePointer = vbHourglass
  32.                 With rsAF
  33.                     .AddNew
  34.                     !Doc_ID = EmailID
  35.                     !a_id = -1
  36.                     !Name = cdFile.FileTitle
  37.                     !FilePath = Left(cdFile.FileName, Len(cdFile.FileName) - Len(cdFile.FileTitle))
  38.                     !order_n = 1
  39.                     !Description = str
  40.                  
  41.                   '  NewFN = AddToFileUserSign "sd"
  42.                  '  AddToFileUserSign "sdddsd"
  43.                    SaveFileToDB cdFile.FileName, !FileBody, !Body_Size
  44.                   '  SaveFileToDB AddToFileUserSign(cdFile.FileName, "Razrabotka"), !FileBody, !Body_Size  Инф о разработчике не нужна!
  45.                    .Update
  46.                 End With
  47.                 If EMMode = EMOpen Then
  48.                    EMMode = EMEdit
  49.                 End If
  50.                 GetEMailAttachFiles
  51.                 Me.MousePointer = vbDefault
  52.             End If
  53.         Case "Delete"
  54.             Response = MsgBox("Вы уверены, что хотите удалить подключенный файл?", vbYesNo + vbQuestion + vbDefaultButton2)
  55.             If Response = vbYes Then
  56.                 If lvAttachFiles.ListItems.Count > 0 Then
  57.                     qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
  58.                     Me.MousePointer = vbHourglass
  59.                     With rsAF
  60.                         .Requery
  61.                         .MoveFirst
  62.                         .Delete
  63.                     End With
  64.                     If EMMode = EMOpen Then
  65.                        EMMode = EMEdit
  66.                     End If
  67.                     GetEMailAttachFiles
  68.                     Me.MousePointer = vbDefault
  69.                 End If
  70.             End If
  71.         Case "Preview"
  72.             If lvAttachFiles.ListItems.Count > 0 Then
  73.                 TempFileName = String(1024, " ")
  74.                 GetTempFileName TempDirectory, "doc", 0, TempFileName
  75.                 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"
  76.                ReDim Preserve TempFiles(UBound(TempFiles) + 1)
  77.                 TempFiles(UBound(TempFiles)) = TempFileName
  78.                
  79.                 If Len(TempFileName) > 0 Then
  80.                     qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
  81.                     Me.MousePointer = vbHourglass
  82.                     With rsAF
  83.                         .Requery
  84.                         .MoveFirst
  85.                         fSize = !Body_Size
  86.                         LoadFileFromDB TempFileName, !FileBody, fSize
  87.                     End With
  88.                     Me.MousePointer = vbDefault
  89.                     TempFileName = Trim(TempFileName)
  90.                     ShellExecute Me.hwnd, "open", TempFileName, 0, 0, SW_SHOWMAXIMIZED
  91.                 End If
  92.             End If
  93.         Case "Edit"
  94.             If lvAttachFiles.ListItems.Count > 0 Then
  95.                 TempFileName = String(1024, " ")
  96.                 GetTempFileName TempDirectory, "doc", 0, TempFileName
  97.                 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"
  98.                ReDim Preserve TempFiles(UBound(TempFiles) + 1)
  99.                 TempFiles(UBound(TempFiles)) = TempFileName
  100.                
  101.                 On Error GoTo err
  102.                 If Len(TempFileName) > 0 Then
  103.                     qAF.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
  104.                     Me.MousePointer = vbHourglass
  105.                     With rsAF
  106.                         .Requery
  107.                         .MoveFirst
  108.                         fSize = !Body_Size
  109.                         LoadFileFromDB TempFileName, !FileBody, fSize
  110.                     End With
  111.                     Me.MousePointer = vbDefault
  112.                     TempFileName = Trim$(TempFileName)
  113.                    
  114.                     Dim AppWord As Word.Application
  115.                     Dim DocWord As Word.Document
  116.                     Set AppWord = New Word.Application
  117.                     Set DocWord = AppWord.Documents.Open(TempFileName)
  118.                     AppWord.Visible = True
  119.                     'ShellExecute Me.hwnd, "open", TempFileName, 0, 0, SW_SHOWMAXIMIZED
  120.                    Select Case MsgBox("После того, как Вы закончите редактирование и закроете WORD," & vbNewLine & " нажмите OK чтобы сохранить файл," & vbNewLine & " или ОТМЕНА, чтобы не сохранять его", vbInformation Or vbOKCancel, "Ожидаю ответа")
  121.                         Case vbOK
  122.                             Dim qAFE          As rdoQuery
  123.                             Dim rsAFE       As rdoResultset
  124.                             On Error GoTo ErrS
  125.                                
  126.                                 strSQL = "SELECT * FROM AttachFiles WHERE Doc_ID=? AND A_ID=?"
  127.                                 Set qAFE = rdoCn.CreateQuery("", strSQL)
  128.                                 qAFE.rdoParameters(0) = EmailID
  129.                                 qAFE.rdoParameters(1) = Right(lvAttachFiles.SelectedItem.Key, Len(lvAttachFiles.SelectedItem.Key) - 1)
  130.                                 Set rsAFE = qAFE.OpenResultset(rdOpenDynamic, rdConcurRowVer)
  131.                                 With rsAFE
  132.                                   .MoveFirst
  133.                                   .Edit
  134.                                   SaveFileToDB TempFileName, !FileBody, !Body_Size
  135.                                   .Update
  136.                                 End With
  137.                                 EMailChange = True
  138.                                 EMMode = LEdit
  139.                                 rsAFE.Close
  140.                                 Set rsAFE = Nothing
  141.                                 qAFE.Close
  142.                                 Set qAFE = Nothing
  143.                                 DocWordEdit_Id = 0
  144.                                 GetEMailAttachFiles
  145.                         Case vbCancel
  146.                             Set DocWord = Nothing
  147.                             Set AppWord = Nothing
  148.                     End Select
  149.                 End If
  150.             End If
  151.     End Select
  152. err:
  153.     rsAF.Close
  154.     Set rsAF = Nothing
  155.     qAF.Close
  156.     Set qAF = Nothing
  157.     BuildToolBar
  158. Exit Sub
  159. ErrS:
  160.     rsAFE.Close
  161.     Set rsAFE = Nothing
  162.     qAFE.Close
  163.     Set qAFE = Nothing
  164.     Set DocWord = Nothing
  165.     Set AppWord = Nothing
  166.     DocWordEdit_Id = 0
  167.     MsgBox "Не удалось сохранить файл" & vbNewLine & err.Number & ": " & err.Description, vbExclamation Or vbOKOnly
  168. End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top