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

 

[Rahulwork]

Hi Dante,

Thanks for your response. while putting above code i m getting following error:

Compile Error - Next Without For

It seems about the last close code where we mentioned next

please help.

 

[DanteAmor]

Make sure you copy the code completely and that the lines do not line up

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

 

[Rahulwork]

Hi Dante,

thanks for your response, by above code i am only getting "End" msgbox apart from that nothing is happening. can i share my file with you?

is it possible?

thanks

 

[DanteAmor]

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.



Share your Excel file with the macro and file you want to upload.

 

[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

Check the original macro, I do not understand how it used to work and now you have errors.

 

[Rahulwork]

Hi Dante,

I can't express my thanks to you in words for helping me. As suggested i have uploaded sample file on box.com. Below is the file link:

https://app.box.com/s/ui4tpkmypuertftqvaf8dwglzhgc2g0v

Details:

1. ShareDrive path will be in C2
2. button will go there and upload all predefine files name (Here "Sample"), starting with sample and upload in D4, E4, F4
3. Caption of file would be file name in sharedrive.

Thanks, let me know if u need any other information

 

[Rahulwork]

Hi Dante, Any luck on this?

 

[DanteAmor]

Try again with the file that worked for you, finally remove the files you do not want to read from your sheet.

 

[Rahulwork]

Hi Dante,

sure i will re-upload the file which is working for me. Wil provide you details soon

Thanks

 

[Rahulwork]

Hi Dante,

sure i will re-upload the file which is working for me. Wil provide you details soon

Thanks

Hi Dante,

I have updated the file with the code which is working for me, here is the new link

https://app.box.com/s/06p8fxdgq2sz7lwa0fz3nx23la4f36lh

Please review and provide your view on the same that what changes i have to made in code to get all file starts with Sample? in different cells

Somewhere i think there is some amendment required here:

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"