Cái này phải dùng win api rồi.
Tức người ta trước đó, vd. lúc 9:35, chạy code để mở tập tin PDF "bằng đường dẫn". Bây giờ, tức lúc 9:43, "đóng file pdf bằng đường dẫn" có nghĩa là chạy code để đóng cái tập tin đã được mở trước đó, lúc 9:35, "bằng đường dẫn".
hiểu theo hướng đơn giản thôi bác, tức là đóng đúng file theo đường dẫn. Với bài này em cũng chẳng phai là hóng mà chỉ là theo em phải dùng api để làm thôi.
Ý mình là mở một số file pdf dựa vào đường dẫn được lưu trên excel. Sau đó sẽ thực hiện đóng file bằng chính những đường dẫn đã mở.
Phải biết bạn dùng chương trình gì để mở mới dựa vào mà viết code vba đóng cửa sổ chương trình đó.chứ nếu là file excel thì mặc định mở là excel rồi chỉ cần biết tên đường dẫn cũng đóng lại được
Bạn nên đưa code mở file lên trước. Khi file pdf đang mở sẽ không xóa hay đổi tên được. Bạn vào đường dẫn đó thử đổi tên, nếu không được thì đóng cửa sổ, tùy theo bạn mở bằng chương trình gì thì cách đóng có thể khác nhau.
Mình dùng phần mềm Foxit phantom đó bạn
Mình mở file từ đường dẫn để xem nội dung file PDF, sau đó dùng code để đổi tên file. Vấn đề mình gặp là cần tự động đóng các file đã mở từ đường dẫn trước thì mới đổi tên file bằng code đươc
Dim Foxit As String, PDF as String
Foxit = "C:\path\FoxitPhantomPDF.exe"
PDF ="D:\file.pdf"
Shell "Cmd.exe /S /K START """" """ & Foxit & """ """ & PDF & """", vbNormalFocusDim AppName As String
AppName = "FoxitPhantomPDF.exe"
Shell "Cmd.exe /S /K TASKKILL /f /fi ""Imagename eq " & AppName, vbHideTức bạn muốn nói tới điểm 1 trong bài của tôi? Nếu thế thì đính kèm cái code mà bạn đã có và bạn dùng để "mở file pdf từ excel bằng đường dẫn".
www.giaiphapexcel.com
Option Explicit
Private Const WM_CLOSE As Long = &H10
#If VBA7 Then
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
#End If
Private ProcID As Long
#If VBA7 Then
Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
Dim ProcessId As Long
EnumWindowsProc = 1
If IsWindowVisible(hWnd) Then
GetWindowThreadProcessId hWnd, ProcessId
If ProcessId = lParam Then
PostMessage hWnd, WM_CLOSE, 0, 0
EnumWindowsProc = 0
End If
End If
End Function
' code de chay thu
Sub runPDF()
Dim filename As String
filename = "c:\bi mat.pdf"
filename = """" & filename & """"
ProcID = Shell("C:\Program Files\Nitro PDF\Professional\nitroPDF.exe " & filename, vbMaximizedFocus)
End Sub
Sub closePDF()
If ProcID = 0 Then Exit Sub
EnumWindows AddressOf EnumWindowsProc, ProcID
End SubMình cảm ơn bạn rất nhiều. Code VBA thật tuyệt!Tức bạn muốn nói tới điểm 1 trong bài của tôi? Nếu thế thì đính kèm cái code mà bạn đã có và bạn dùng để "mở file pdf từ excel bằng đường dẫn".
Không phải vô cớ mà tôi muốn biết, bạn muốn đóng tập tin nào, đã được mở như thế nào. Tùy cách mở mà lựa chọn cách đóng thôi. Tôi không biết bạn mở thế nào thì hơi khó để lựa cách đóng. Đóng tập tin mà chính code vừa mở có thể khác với đóng tập tin mà người dùng tự mở hằng hà sa số.
-------------
Ví dụ tôi mở Nitro PDF như trong runPDF, và đóng như trong closePDF (Module1 ở dưới)
Cũng có thể tham khảo bài trong chủ đề.
làm thế nào để đóng một ứng dụng để không bị lỗi ?
Mình đang dùng câu lệnh sau để đóng chrome nhưng gặp vấn đề là lần sau khi mở lại nó báo lỗi ..do không được đóng đúng cách.. Mình muốn hỏi ngoài cách đóng này ra có cách nào đóng để lần tới mở chrome thì không bị thông báo " Chorme didn't shut down correctly. hay có cách đóng nào giống như mình...
Module1
Mã:Option Explicit Private Const WM_CLOSE As Long = &H10 #If VBA7 Then Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long #Else Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long #End If Private ProcID As Long #If VBA7 Then Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long #Else Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long #End If Dim ProcessId As Long EnumWindowsProc = 1 If IsWindowVisible(hWnd) Then GetWindowThreadProcessId hWnd, ProcessId If ProcessId = lParam Then PostMessage hWnd, WM_CLOSE, 0, 0 EnumWindowsProc = 0 End If End If End Function ' code de chay thu Sub runPDF() Dim filename As String filename = "c:\bi mat.pdf" filename = """" & filename & """" ProcID = Shell("C:\Program Files\Nitro PDF\Professional\nitroPDF.exe " & filename, vbMaximizedFocus) End Sub Sub closePDF() If ProcID = 0 Then Exit Sub EnumWindows AddressOf EnumWindowsProc, ProcID End Sub
Tức bạn muốn nói tới điểm 1 trong bài của tôi? Nếu thế thì đính kèm cái code mà bạn đã có và bạn dùng để "mở file pdf từ excel bằng đường dẫn".
Không phải vô cớ mà tôi muốn biết, bạn muốn đóng tập tin nào, đã được mở như thế nào. Tùy cách mở mà lựa chọn cách đóng thôi. Tôi không biết bạn mở thế nào thì hơi khó để lựa cách đóng. Đóng tập tin mà chính code vừa mở có thể khác với đóng tập tin mà người dùng tự mở hằng hà sa số.
-------------
Ví dụ tôi mở Nitro PDF như trong runPDF, và đóng như trong closePDF (Module1 ở dưới)
Cũng có thể tham khảo bài trong chủ đề.
làm thế nào để đóng một ứng dụng để không bị lỗi ?
Mình đang dùng câu lệnh sau để đóng chrome nhưng gặp vấn đề là lần sau khi mở lại nó báo lỗi ..do không được đóng đúng cách.. Mình muốn hỏi ngoài cách đóng này ra có cách nào đóng để lần tới mở chrome thì không bị thông báo " Chorme didn't shut down correctly. hay có cách đóng nào giống như mình...
Module1
Mã:Option Explicit Private Const WM_CLOSE As Long = &H10 #If VBA7 Then Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long #Else Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long #End If Private ProcID As Long #If VBA7 Then Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long #Else Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long #End If Dim ProcessId As Long EnumWindowsProc = 1 If IsWindowVisible(hWnd) Then GetWindowThreadProcessId hWnd, ProcessId If ProcessId = lParam Then PostMessage hWnd, WM_CLOSE, 0, 0 EnumWindowsProc = 0 End If End If End Function ' code de chay thu Sub runPDF() Dim filename As String filename = "c:\bi mat.pdf" filename = """" & filename & """" ProcID = Shell("C:\Program Files\Nitro PDF\Professional\nitroPDF.exe " & filename, vbMaximizedFocus) End Sub Sub closePDF() If ProcID = 0 Then Exit Sub EnumWindows AddressOf EnumWindowsProc, ProcID End Sub
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As LongPtr
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
' TaÒi ýìng duòng nêìu không có Internet
' Vào cùng ðýõÌng dâÞn võìi File có VBA và giaÒi nén vào thý muòc handle
' Nêìu có Internet thiÌ týò ðôòng
Private Const URL$ = "https://download.sysinternals.com/files/Handle.zip"
Public Sub CloseAppOpenFile()
On Error Resume Next
Dim a, FilePath As String
FilePath = "D:\file.pdf"
a = CheckFileInApp(FilePath)
a = VBA.Split(a(0), " pid: ", , 1)
Select Case VBA.UCase(VBA.Trim(a(0)))
Case "EXCEL.EXE", "WORD.EXE", "POWERPOINT.EXE":
VBA.GetObject(FilePath).Close True
Case "ACCESS.EXE"
VBA.GetObject(FilePath).CloseCurrentDatabase
Case Else
Shell "Cmd.exe /S /K TASKKILL /f /fi ""Imagename eq " & VBA.Trim(a(0)), vbHide
End Select
End Sub
Private Function CheckFileInApp(FilePath As String) As Variant
On Error Resume Next
DoEvents
If Not DownloadHandle Then Exit Function
Dim temp$, i As Integer, k As Integer
temp = PathHandle
If VBA.Dir(temp & "log.txt", vbSystem) <> "" Then
Kill temp & "log.txt"
End If
Dim aHandle As String
#If Win64 Then
aHandle = "handle64.exe"
#Else
aHandle = "handle.exe"
#End If
With VBA.CreateObject("WScript.Shell")
.Run "cmd.exe /s /k cd """ & temp & """ && " & aHandle & " """ & FilePath & """ >" & temp & "log.txt && exit", 0, True
End With
Application.Wait VBA.Now + VBA.TimeSerial(0, 0, 1)
With VBA.CreateObject("ADODB.Stream")
.Open
.Charset = "utf-8"
.LoadFromFile temp & "log.txt"
CheckFileInApp = VBA.Split(.ReadText, " type: ", , 1)
.Close
End With
End Function
Private Function DownloadHandle() As Boolean
On Error Resume Next
Dim Tmp$, temp$, zip$, File
zip = "handle.zip"
temp = PathHandle
VBA.MkDir temp
VBA.err.Clear
If VBA.Dir(temp & "handle.exe", vbDirectory) <> "" Then GoTo Ends
If URLDownloadToFile(0, URL, temp & zip, 0, 0) = 0 Then
Application.Wait VBA.Now + VBA.TimeSerial(0, 0, 2)
With VBA.CreateObject("Shell.Application")
.Namespace(CVar(temp)).CopyHere .Namespace(CVar(temp & zip)).Items, &H10&
End With
End If
Kill temp & zip
Ends:
DownloadHandle = VBA.err.Number = 0
End Function
Private Function PathHandle() As String
PathHandle = ThisWorkbook.Path & "\handle\"
End FunctionChính vì vấn đề rất phụ thuộc vào cách mở PDF mà tôi đã khó tính. Với tôi không chỉ 1 câu cụt lủn "mở bằng đường dẫn", "đóng bằng đường dẫn" là được.
Mình cảm ơn bạn rất nhiều
Bạn thử test trên các máy của bạn xem sao.
Function defaultExe(ByVal ext As String) As String
Dim k As Long, key As String, filePath As String, shell As Object
Set shell = CreateObject("WScript.Shell")
key = shell.RegRead("HKCR\." & ext & "\")
filePath = shell.RegRead("HKCR\" & key & "\Shell\open\command\")
k = InStrRev(filePath, " ")
filePath = Left(filePath, k - 1)
Set shell = Nothing
defaultExe = filePath
End Function
Sub test()
Dim exePath As String
' ung dung mac dinh mo tap tin PDF
exePath = defaultExe("pdf")
MsgBox exePath
End Sub
