Upload multiple Object into Excel - Code amendment

[Rahulwork]

Hi Everyone,

I have a code to upload an object into excel. However below code i am able to upload only one document by clicking on button. Please help me in amend the code by which i can upload multiple file.

note - other file path would remain same. However name could be sample2.pdf or sample3.pdf


Sub Button21_Click()

Dim strPath As String
Dim strFilename As String
Dim strCaption As String
Dim wksTarget As Worksheet
Dim rngTarget As Range

Set wksTarget = Worksheets("Sheet1")

Set rngTarget = wksTarget.Range("A3") 'change the location in which to insert your object as desired

strPath = wksTarget.Range("A1").Value
If Right(strPath, 1) <> "" Then
strPath = strPath & ""
End If

strFilename = "sample.pdf"

If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"
Exit Sub
End If

strCaption = "myCaption" 'change the caption as desired

wksTarget.OLEObjects.Add _
Filename:=strPath & strFilename, _
link:=False, _
displayasicon:=True, _
iconfilename:="", _
iconindex:=0, _
iconlabel:=strCaption, _
Left:=rngTarget.Left, _
Top:=rngTarget.Top, _
Width:=150, _
Height:=10

End Sub

 

[DanteAmor]

Try this.
Update the blue lines with the names of your files and their respective cells

Sub Button21_Click()


    Dim strPath As String
    Dim strFilename As String
    Dim strCaption As String
    Dim wksTarget As Worksheet
    Dim rngTarget As Range
    Dim wFiles As Variant
    Dim wCells As Variant
    Dim i As Long
    
    Set wksTarget = Worksheets("Sheet1")
    
    
    strPath = wksTarget.Range("A1").Value
    If Right(strPath, 1) <> "" Then
        strPath = strPath & ""
    End If
    
[COLOR=#0000ff]    wFiles = Array("sample1.pdf", "sample2.pdf", "sample3.pdf")[/COLOR]
[COLOR=#0000ff]    wCells = Array("A3", "C3", "E3")[/COLOR]
    
    For i = LBound(wFiles) To UBound(wFiles)
    
        strFilename = wFiles(i)
        If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
            MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"
            
        Else
        
            strCaption = strFilename '"myCaption" 'change the caption as desired
            Set rngTarget = wksTarget.Range(wCells(i))


            wksTarget.OLEObjects.Add _
                Filename:=strPath & strFilename, _
                    link:=False, _
                    displayasicon:=True, _
                    iconfilename:="", _
                    iconindex:=0, _
                    iconlabel:=strCaption, _
                    Left:=rngTarget.Left, _
                    Top:=rngTarget.Top, _
                    Width:=150, _
                    Height:=10
        End If
    Next
    
    MsgBox "End"
End Sub

-----------------------


If you are going to put the file names, for example from cell B2 down.
Try this

Sub Button21_Click()


    Dim strPath As String
    Dim strFilename As String
    Dim strCaption As String
    Dim wksTarget As Worksheet
    Dim rngTarget As Range
    Dim wFiles As Variant
    Dim wCells As Variant
    Dim i As Long, u As Long
    
    Set wksTarget = Worksheets("Sheet1")
    
    
    strPath = wksTarget.Range("A1").Value
    If Right(strPath, 1) <> "" Then
        strPath = strPath & ""
    End If
    
    'wFiles = Array("sample1.pdf", "sample2.pdf", "sample3.pdf")
    'wCells = Array("A3", "C3", "E3")
    u = wksTarget.Range("B" & Rows.Count).End(xlUp).Row
    
    For i = 2 To u 'LBound(wFiles) To UBound(wFiles)
    
        strFilename = wksTarget.Cells(i, "B").Value
        If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
            MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"
            
        Else
        
            strCaption = strFilename '"myCaption" 'change the caption as desired
            Set rngTarget = wksTarget.Cells(i, "C")


            wksTarget.OLEObjects.Add _
                Filename:=strPath & strFilename, _
                    link:=False, _
                    displayasicon:=True, _
                    iconfilename:="", _
                    iconindex:=0, _
                    iconlabel:=strCaption, _
                    Left:=rngTarget.Left, _
                    Top:=rngTarget.Top, _
                    Width:=150, _
                    Height:=10
        End If
    Next
    
    MsgBox "End"
End Sub

 

[Rahulwork]

Hi Dante,

Thank you so much for your response. This code is working fine.

However there could be chance that sample2 or sample3 files could be exist or could be not. Above code is working perfectly if i they are exist however in there absence i m getting Run-time error 1004 stating that file name or path does not exist. what amendment i have to make in code to avoid that?

Thanks for your help.

Regards

 

[Rahulwork]

Hi Dante,

Thank you so much for your response. This code is working fine.

However there could be chance that sample2 or sample3 files could be exist or could be not. Above code is working perfectly if i they are exist however in there absence i m getting Run-time error 1004 stating that file name or path does not exist. what amendment i have to make in code to avoid that?

Or can we do one thing that, macro will pick only those files which names are starting with "Sample" and upload in A3...C3...E3...and so on depend on the number of files.

Thanks for your help.

Regards

 

[DanteAmor]

Hi Dante,

Thank you so much for your response. This code is working fine.

However there could be chance that sample2 or sample3 files could be exist or could be not. Above code is working perfectly if i they are exist however in there absence i m getting Run-time error 1004 stating that file name or path does not exist. what amendment i have to make in code to avoid that?

Or can we do one thing that, macro will pick only those files which names are starting with "Sample" and upload in A3...C3...E3...and so on depend on the number of files.

Thanks for your help.

Regards

Try with this.
his instruction checks if the file exists, if not, it sends a message.

If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"

Sub Button21_Click()


    Dim strPath As String
    Dim strFilename As String
    Dim strCaption As String
    Dim wksTarget As Worksheet
    Dim rngTarget As Range
    Dim wFiles As Variant
    Dim wCells As Variant
    Dim i As Long, u As Long
    
    Set wksTarget = Worksheets("Sheet1")
    
    strPath = wksTarget.Range("A1").Value
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    
    u = wksTarget.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 3 To u
    
        strFilename = wksTarget.Cells(i, "A").Value
        If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
            MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"
            
        Else
        
            strCaption = strFilename '"myCaption" 'change the caption as desired
            Set rngTarget = wksTarget.Cells(i, "C")


            wksTarget.OLEObjects.Add _
                Filename:=strPath & strFilename, _
                link:=False, displayasicon:=True, _
                iconfilename:="", iconindex:=0, _
                iconlabel:=strCaption, Left:=rngTarget.Left, _
                Top:=rngTarget.Top, Width:=150, Height:=10
        End If
    Next
    
    MsgBox "End"
End Sub

If the error message appears again, tell me exactly what you have in cell A1, what you have in the cell of the file with error and what you have in your folder.

 

[Rahulwork]

Thank you for your response.

In above code where i should mention that code will pick all files start with "Sample"?

 

[Rahulwork]

In A1 i have shareDrive link of supplier folders, in which i have multiple documents. with the name of sample 1, sample 2 or sample 3 so on.... it could be that there would be only 1 document or could be 6 (max) but naming convention would start with "sample". So now i want to upload all relevant document in one go in horizon way. like A3, C3..

 

[DanteAmor]

You must tell me the data you have in A1 and the names of the files that send the error and what you have in the folder, I need to check the names.

And if in the cells A3, A4, etc, you only put the files that you are going to read?

 

[Rahulwork]

Hello, thanks for your response:

under the A1 i have shareDrive link - F:\My Project\ABC

ABC is one of the supplier name and one the name of the supplier i made this folder.

Under ABC i have following files: (Number of file could be different but naming convention would be remain same)
Sample.pdf
Sample2.pdf
Test.txt
Test2.docx
Sample3.pdf
Sample4.docx

Now on sheet i have a button, where you helped me to upload "PDF" files into the excel where i have to mentioned the file complete name in code.

but by above code i have to mention the complete name of the file in code but i want to know that

1. Is there any way that if we put some condition that by clicking on button only those file will upload which name start with "Sample"? and all files will be upload at A3, B3, C3... so on depend on the number of files identify in path mentioned in A1

2. if Yes, is it possible to get multiple iconfilename for all files. like for pdf file it would be pdf icon and for doc it would be doc icon.

thnk you so much dante for your kind help

 

[DanteAmor]

Try this

Sub Button21_Click()




    Dim strPath As String
    Dim strFilename As String
    Dim strCaption As String
    Dim wksTarget As Worksheet
    Dim rngTarget As Range
    Dim wFiles As Variant
    Dim wCells As Variant
    Dim i As Long, u As Long
    
    Set wksTarget = Worksheets("Sheet1")
    
    strPath = wksTarget.Range("A1").Value
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    
    u = wksTarget.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 3 To u
    
        strFilename = wksTarget.Cells(i, "A").Value
        If LCase(Left(strFilename, "6")) = LCase("Sample") Then
        
            If Len(Dir(strPath & strFilename, vbNormal)) = 0 Then
                MsgBox "'" & strPath & strFilename & "' does not exist!", vbExclamation, "Path and/or file?"
                
            Else
            
                strCaption = strFilename '"myCaption" 'change the caption as desired
                Set rngTarget = wksTarget.Cells(i, "C")
    
                wksTarget.OLEObjects.Add _
                    Filename:=strPath & strFilename, _
                    link:=False, displayasicon:=True, _
                    iconfilename:="", iconindex:=0, _
                    iconlabel:=strCaption, Left:=rngTarget.Left, _
                    Top:=rngTarget.Top, Width:=150, Height:=10
            End If
        End If
    Next
    
    MsgBox "End"
End Sub