VBA code to attach a Single file to different Cells on Multiple Sheets

[jassy0211]

Hi all, I am a complete novice with VBA but I am loving the learning curve. I have been searching for ever for a solution to my post but I have been unable to find one. At the moment I have put together the code below that works but the issue with it is that you need to keep selecting the folder and file for each cell in each sheet that you want the attachment to be added to. Is there a way of doing this were I only need to select the folder and file one time and it will then go add the attachment to the specified Sheets and Cells.

My code

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Private Sub CommandButton1_Click()
Call Module22.CommandButton1_Click
Call Module23.CommandButton1_Click
Call Module24.CommandButton1_Click
End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Module 22[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Public Sub CommandButton1_Click()
Application.Goto (ActiveWorkbook.Sheets("Sheet1").Range("C71"))
'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
If LCase(fpath) = "false" Then Exit Sub

'Insert file
ActiveSheet.OLEObjects.Add _
FileName:=fpath, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="excel.exe", _
IconIndex:=0, _
IconLabel:=extractFileName(fpath)

End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Module 23[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Public Sub CommandButton1_Click()
Application.Goto (ActiveWorkbook.Sheets("Sheet2").Range("C71"))
'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
If LCase(fpath) = "false" Then Exit Sub

'Insert file
ActiveSheet.OLEObjects.Add _
FileName:=fpath, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="excel.exe", _
IconIndex:=0, _
IconLabel:=extractFileName(fpath)

End Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
Module 24[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Public Sub CommandButton1_Click()
Application.Goto (ActiveWorkbook.Sheets("Sheet3").Range("C71"))
'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
If LCase(fpath) = "false" Then Exit Sub

'Insert file
ActiveSheet.OLEObjects.Add _
FileName:=fpath, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="excel.exe", _
IconIndex:=0, _
IconLabel:=extractFileName(fpath)

End Sub[/FONT]

 

[daverunt]

Hi,

assuming it's the same file you are attaching and it is to all of the sheets, then the following should work.

Should the attachment not be required in all sheets then perhaps add a check for the worksheet names you want or don't want it in, whichever is the shorter.

Public Sub CommandButton1_Click()
 
'Get file path
 fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
 fileNme = Dir(fpath)

 If LCase(fpath) = "false" Then Exit Sub



For Each Sheet In ActiveWorkbook.Sheets
Sheet.Activate
Range("C71").Activate

 'Insert file
 ActiveSheet.OLEObjects.Add _
 Filename:=fpath, _
 Link:=False, _
 DisplayAsIcon:=True, _
 IconFileName:="excel.exe", _
 IconIndex:=0, _
 IconLabel:=fileNme
 
 Next

 End Sub

 

[jassy0211]

daverunt, thank you thank you thank you, this works a treat. May I be so bold to ask how i would perhaps attach the file to C71 on Sheet1 and also say C130 on Sheet2 & Sheet3 but dont attach it to Sheet4 & Sheet5. Any help on this would leave me forever grateful.

 

[jassy0211]

Hello again daverunt, you can ignore my last plea as I worked something out and have it running as I would like it too. My code is below. Not sure if this was the only way to do it and if not perhaps it wasnt the most elegant but the main thing is it works for what I want it to do, thanks again for the assist.

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Public Sub CommandButton2_Click()

'Get file path
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file")
fileNme = Dir(fpath)[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] If LCase(fpath) = "false" Then Exit Sub[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]
'This will attach the file to Cell I4 on Sheet1 only
For Each Sheet In ActiveWorkbook.Sheets
If Not Sheet.Name = "Sheet2" _
And Not Sheet.Name = "Sheet3" _
And Not Sheet.Name = "Sheet4" _
And Not Sheet.Name = "Sheet5" _
And Not Sheet.Name = "Sheet6" _
And Not Sheet.Name = "Sheet7" Then
Sheet.Activate
Range("I4").Activate
End If
'This will attach the file to Cell C18 on Sheets2 to Sheets5 only
If Not Sheet.Name = "Sheet1" _
And Not Sheet.Name = "Sheet6" _
And Not Sheet.Name = "Sheet7" Then
Sheet.Activate
Range("C18").Activate
End If
'Insert file
ActiveSheet.OLEObjects.Add _
FileName:=fpath, _
Link:=False, _
DisplayAsIcon:=True, _
IconFileName:="excel.exe", _
IconIndex:=0, _
IconLabel:=fileNme

Next[/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] End Sub
[/FONT]

 

[daverunt]

Glad you got it working.