این کد ساده، در یک جدول اکسل، آدرس عکس رو می گیره و اون رو ذخیره میکنه. ضمنا نام فایل رو برای ذخیره از یکی از سلول ها برمیداریم.
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
Sub GetPageTitle()
Dim i As Long, url As String, path As String
For i = 2 To 444
DoEvents
url = Sheet1.Range("m" & i).Value
path = "D:\site\___1392\____sabtenam\aksha\" & Sheet1.Range("A" & i).Value & "-cart.jpg"
URLDownloadToFile 0, url, path, 0, 0
Next
End Sub
اما اگر سلولی که نام فایل رو ازش می خواهیم برداریم فارسی باشه، کد عمل نمی کنه.
برای رفع این مشکل کد زیر رو پیدا کردم که کار می کنه، اما نمیدونم چطوری با کد بالا تلفیقش کنم
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function User32MsgBox Lib "user32" Alias "MessageBoxW" _
(Optional ByVal hWnd As Long, Optional ByVal Prompt As Long, _
Optional ByVal Title As Long, Optional ByVal Buttons As Long) As Long
#Else
Private Declare Function User32MsgBox Lib "user32" Alias "MessageBoxW" _
(Optional ByVal hWnd As Long, Optional ByVal Prompt As Long, _
Optional ByVal Title As Long, Optional ByVal Buttons As Long) As Long
#End If
Public Function MessageBoxW(cPrompt As String, _
Optional cButtons As VbMsgBoxStyle = vbOKOnly, _
Optional cTitle As String) As Long
MessageBoxW = User32MsgBox(0, StrPtr(cPrompt), StrPtr(cTitle), cButtons)
'*****Probably need to convert StrPtr to 32bit long on 64bit - see next line
'MessageBoxW = User32MsgBox(0, cLng(StrPtr(cPrompt)), CLng(StrPtr(cTitle)), cButtons)
End Function
Sub MyMacro()
Dim txt As String
txt = Sheets("Sheet1").Cells(1, 1).Value
MessageBoxW (txt)
End Sub
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub GetPageTitle()
Dim i As Long, url As String, path As String
For i = 2 To 444
DoEvents
url = Sheet1.Range("m" & i).Value
path = "D:\site\___1392\____sabtenam\aksha\" & Sheet1.Range("A" & i).Value & "-cart.jpg"
URLDownloadToFile 0, url, path, 0, 0
Next
End Sub
اما اگر سلولی که نام فایل رو ازش می خواهیم برداریم فارسی باشه، کد عمل نمی کنه.
برای رفع این مشکل کد زیر رو پیدا کردم که کار می کنه، اما نمیدونم چطوری با کد بالا تلفیقش کنم
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function User32MsgBox Lib "user32" Alias "MessageBoxW" _
(Optional ByVal hWnd As Long, Optional ByVal Prompt As Long, _
Optional ByVal Title As Long, Optional ByVal Buttons As Long) As Long
#Else
Private Declare Function User32MsgBox Lib "user32" Alias "MessageBoxW" _
(Optional ByVal hWnd As Long, Optional ByVal Prompt As Long, _
Optional ByVal Title As Long, Optional ByVal Buttons As Long) As Long
#End If
Public Function MessageBoxW(cPrompt As String, _
Optional cButtons As VbMsgBoxStyle = vbOKOnly, _
Optional cTitle As String) As Long
MessageBoxW = User32MsgBox(0, StrPtr(cPrompt), StrPtr(cTitle), cButtons)
'*****Probably need to convert StrPtr to 32bit long on 64bit - see next line
'MessageBoxW = User32MsgBox(0, cLng(StrPtr(cPrompt)), CLng(StrPtr(cTitle)), cButtons)
End Function
Sub MyMacro()
Dim txt As String
txt = Sheets("Sheet1").Cells(1, 1).Value
MessageBoxW (txt)
End Sub
لطفا راهنمایی کنید چطوری با کد اول تلفیقش کنم؟ یا اینکه بگویید چه کنیم تا در کد اول فارسی هم فهمیده شود؟
با تشکر قبلی
با تشکر قبلی
کامنت