How to attach files and store them in cells? - excel

Question

I'm trying to attach files and store them in cells G2 and on.
However, every time I input it gets input in G2. If a user decides to enter more data the input data will iterate into a new row but the attachment stays in row G2 and takes the place of the previous one.
textbox2 in userform gets skipped every time I press enter. I want my users to navigate with keyboards but if I'm done in textbox1 and press enter it will throw me to textbox3 rather than textbox2.
Private Sub SubmitButton_Click()
Dim iRow As Long
Dim wrkSht As Worksheet
Set wrkSht = Worksheets("Sheet1")
Dim emailApplication As Object
Dim emailItem As Object
iRow = wrkSht.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
If Trim(RequesterBox.Value) = "" Then
RequesterBox.SetFocus
MsgBox "Please complete the form"
Exit Sub
End If
wrkSht.Cells(iRow, 1).Value = RequesterBox.Value
wrkSht.Cells(iRow, 2).Value = SquadronBox.Value
wrkSht.Cells(iRow, 3).Value = EmailBox.Value
wrkSht.Cells(iRow, 4).Value = PhoneBox.Value
wrkSht.Cells(iRow, 5).Value = LocationBox.Value
wrkSht.Cells(iRow, 6).Value = DescriptionBox.Value
MsgBox "Request has been added Succesfully. Thanks for you submition, someone will be contacting you shortly", vbOKOnly + vbInformation, "Thanks"
'----------------------- Send Email-----------------------'
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)
emailItem.To = ""
emailItem.Subject = "Facility Request"
emailItem.Body = "A request for " & LocationBox.Value & " has been submited with the following description: " & Chr(10) & _
DescriptionBox.Value
emailItem.Display
Set emailItem = Nothing
Set emailItemApplication = Nothing
RequesterBox.Value = ""
SquadronBox.Value = ""
EmailBox.Value = ""
PhoneBox.Value = ""
LocationBox.Value = ""
DescriptionBox.Value = ""
RequesterBox.SetFocus
End Sub
Private Sub AttachButton_Click()
Set wrkSht = Worksheets("Sheet1")
Dim LinksList As Range
Dim iRow As Long
Dim LinkAttached As Long
Set LinksList = Range("G2")
Sheet1.Range("G2").Select
'declare last row to insert link to
lastRowLink = WorksheetFunction.CountA(Sheets("Sheet1").Range("G:G"))
Sheets("Sheet1").Cells(lastRow + 1, 11).Value = LinkAttached
ChDrive "C:\"
ChDir "C:\"
Filt = "PNG Files(*.png),*.png ," & _
"Jpeg Files(*.jpeg),*.jpg ," & _
"PDF Files (*.pdf),*.pdf ," & _
"All Files (*.*),*.*"
FilterIndex = 1
Title = "Select a File to Hyperlink"
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)
If FileName <> False Then
wrkSht.Hyperlinks.Add Anchor:=LinksList, _
Address:=FileName, _
TextToDisplay:=FileName
Else
MsgBox "No file was selected.", vbCritical, "Loading Error"
Exit Sub
End If
End Sub

Answer 1

Hy i hope it will help you
Private Sub AttachButton2_Click()
Dim lastRow As Long, nextId As Long
Dim ws As Worksheet
Dim newRecord As Range
Set ws = ThisWorkbook.Worksheets("Sheet1")
With ws
'getlcurrent last row
lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
'get next Id
nextId = Val(.Range("G" & lastRow).Value) + 1
'set new record
Set newRecord = .Range("G" & lastRow + 1)
'insert data
newRecord.Value = nextId
'select file
ChDrive "C:\"
ChDir "C:\"
Filt = "PNG Files(*.png),*.png ," & _
"Jpeg Files(*.jpeg),*.jpg ," & _
"PDF Files (*.pdf),*.pdf ," & _
"All Files (*.*),*.*"
FilterIndex = 1
Title = "Select a File to Hyperlink"
Filename = Application.GetOpenFilename _
(FileFilter:=Filt, _
FilterIndex:=FilterIndex, _
Title:=Title)
If Filename <> False Then
.Hyperlinks.Add Anchor:=newRecord, _
Address:=Filename, _
TextToDisplay:=Filename
Else
MsgBox "No file was selected.", vbCritical, "Loading Error"
Exit Sub
End If
End With
End Sub