VBA Save File From Link as same extension

[Guna13]

Hi Team

I wonder whether someone can help me, please.

Hyperlink had different type of extention like .xlsx. xls, pdf, .msg documents, all document should download and saveas in folder same extention

Could someone possible tell me please is there a way by which I can amend the code.

To help this is the code which I use to create the list of files.


Option Explicit

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

Dim Ret As Long

'~~> This is where the images will be saved. Change as applicable
Const ParentFolderName As String = "\\gssux002\GBS_CHE_GL_TMS\ICV\"
Sub Download_Report()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
Dim Folderpath, strPath As String

Set ws = Sheets("ICV Report")

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

Folderpath = ParentFolderName & ws.Range("A" & i).Value & "\"

If Len(Dir(Folderpath, vbDirectory)) = 0 Then
MkDir Folderpath
End If

strPath = Folderpath & ws.Range("A" & i).Value & i & "*.*"
Ret = URLDownloadToFile(0, ws.Range("H" & i).Value, strPath, 0, 0)

If Ret = 0 Then
ws.Range("I" & i).Value = "File successfully downloaded"
Else
ws.Range("I" & i).Value = "Unable to download the file"
End If

Next i

MsgBox "Completed This process !!!", vbInformation

End Sub

 

[Guna13]

currently, this code is running, but there is no document save in that folder ...