How to Add upload attachment button in VBA excel - excel

I've developed a small ticketing system on excel VBA
The Save button will take all data from textboxes and radio button and add it to the row number 7 (in this case)
But when I press upload I can't add the link to the label of attachments
How to add link to the attachment label using (upload file ) button
And also save the Link value stored in upload file button to use it later in clear button and save button?
I'm confused to work with private sub and private dim variables.
I'm newbie in VBA please help
User Form of the System
Save Button Code
Upload button code
Public Sub btnAttachment_Click()
'To upload file link format is png, jpeg, PDF or All files'
Dim wks As Worksheet
Dim LinksList As Range
Dim lastRowLink As Long
Dim LinkAttached As Long
Set wks = ActiveSheet
Set LinksList = Range("N1")
'declare last row to insert link to
lastRowLink = WorksheetFunction.CountA(Sheets("Tickets").Range("A:A"))
Sheets("Tickets").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
wks.Hyperlinks.Add Anchor:=LinksList, _
Address:=Filename, _
TextToDisplay:=Filename
Else
MsgBox "No file was selected.", vbCritical, "Loading Error"
Exit Sub
End If
End Sub
Attachment PDF file link contains the code and photo too
Buttons Code link

Related

Insert file displayed as icon without displaying long file name

I want to add a file to Excel, mostly Outlook mail, but I want to limit their size of the icon.
If created from file (Outlook mail), the file is large due to the length of the file name.
If displayed as icon only it is ok, but when I save the document, the file resumes its original appearance (icon and name).
Satisfactory solutions:
importing the file and displaying it as an icon only, but so that it doesn't change after saving;
removal of the title - the icon itself would remain;
inserting another icon (shape) that would be a link to the inserted file
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim FileToOpen As Variant
Dim OtherFormat As String
Dim objInserted As Object
Dim rngSize As Range
Dim sh As Worksheet
OtherFormat = "packager.dll"
Set sh = ThisWorkbook.Sheets("Szacowania")
If Not Intersect(Target, Range("G16:G100")) Is Nothing Then
Dim cel As Range
For Each cel In Target
With cel
'kolumna H - Analiza
If Target.Column = 7 Then
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="All Files (*.*),*.*")
sh.Range("G" & Target.row).Select
If FileToOpen <> False Then
activesheet.OLEObjects.Add( _
Filename:=FileToOpen, _
Link:=False, _
IconFileName:=OtherFormat, _
DisplayAsIcon:=True, _
IconIndex:=0, _
IconLabel:=FileToOpen). _
Select
End If
End If
End With
Next
End If
End Sub

Button to show Save As dialog, then save to a set location

I've been stuck on this for some time now, help would be greatly appreciated.
I've got this concept working when the workbook is closed, but all it does is save to the location specified. Now, I would like to adapt it so once a button is pressed, it will ask the user to save to a location, then once saved, excel will save it to another location of my choosing.
I keep getting an error message "Argument not optional" when the button is pressed.
Thank you.
Private Sub Save(Cancel As Boolean)
NameOfWorkbook = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
Dim varResult As Variant
'displays the save file dialog
varResult = Application.GetSaveAsFilename
'checks to make sure the user hasn't canceled the dialog
If varResult <> False Then
Cells(2, 1) = varResult
MyMsg = NameOfWorkbook + " " & "saved to return note folder"
MsgBox MyMsg
'Create and assign variables
Dim saveLocation As String
saveLocation = "S:\Office information\Returns\Return Notes\" + NameOfWorkbook
'Save Active Sheet(s) as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation
End If
End Sub
You dont use the sub argument so, as Siddharth pointed out, you should correct Private Sub Save().
Furthermore, Save is a reserved word in excel, so I wouldn't use it as a Sub name.

Exporting to PDF Macro Missing Shapes

I have a macro that, upon clicking a button, will generate a barcode image (the image is composed of nothing but shapes), and after that, will export 3 sheets to a pdf. The problem I'm having is that doing this will generate the barcode image, but when exporting as a PDF the shapes that were used to generate to barcode don't show up. They will show up if I print or print to pdf without using the export to pdf macro, but that defeats the point of the macro.
An even bigger headache is that this code is on a different version (spreadsheet is a template) of the spreadsheet, but the macro process is working just fine on that spreadsheet. I copy/pasted the working code to the spreadsheet that's giving me trouble and the trouble maker is still not working. Below is the related code. Why are the shapes not being included on the exported PDF?
Sub BevelPrint_Click()
' DisplayBarcode generates a code128 scannable barcode. Max of 14 characters for the selected line width and max width
Call DisplayBarcode
Sheets(Array("(Cal Cert) Page 1 of 3", "(Cal Cert) Page 2 of 3", "(Cal Cert) Page 3 of 3")).Select
' If Application.Dialogs(xlDialogPrinterSetup).Show = True Then
Dim varResult As Variant
Dim ActBook As Workbook
Dim defaultPath As String
Dim WorkbookName As String
'Dim fso As New Scripting.FileSystemObject
' WorkbookName = fso.GetBaseName(ThisWorkbook.Name)
WorkbookName = ThisWorkbook.Sheets("(0) Calibration System QC").Range("B2").Value
WorkbookName = WorkbookName & " Cert"
defaultPath = "\\TSISVFP01\MANUFACTURING\W405 - Particle\"
defaultPath = defaultPath & WorkbookName
'displays the save file dialog
varResult = Application.GetSaveAsFilename(FileFilter:= _
"PDF File (*.pdf), *.pdf, Excel Files (*.xlsx), *.xlsx", Title:="Save Cert as PDF", _
InitialFileName:=defaultPath)
If varResult <> False Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
varResult, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End If
' End If
Sheets("(0) Calibration System QC").Select
End Sub
Sub DisplayBarcode()
Dim s As Shape
ThisWorkbook.Worksheets("(Cal Cert) Page 1 of 3").Activate
For Each s In ThisWorkbook.Worksheets("(Cal Cert) Page 1 of 3").Shapes
If s.Name Like "*Straight*" Then
ThisWorkbook.Worksheets("(Cal Cert) Page 1 of 3").Shapes(s.Name).Select
Selection.Delete
End If
Next s
Code128Generate_v2 184, 72, 9, 1.5, Worksheets("(Cal Cert) Page 1 of 3"), ThisWorkbook.Sheets("(0) Calibration System QC").Range("B2"), 40
Dim t As Shape
For Each t In ThisWorkbook.Worksheets("(Cal Cert) Page 1 of 3").Shapes
t.ControlFormat.PrintObject = True
Next t
End Sub

Excel VBA save file as word document in default folder

Sub Submit_Click()
Dim wApp As Object
Dim wDoc As Object
Set wApp = CreateObject("Word.Application")
wApp.Visible = True
'Retrieves the word doc template and inserts values from the userform using bookmarks
Set wDoc = wApp.Documents.Open(Filename:="C:\Users\Documents\template1.docx ", ReadOnly:=False)
With wDoc
.Bookmarks("bookmark1").Range.Text = Me.TextBox1.Value
.Bookmarks("bookmark2").Range.Text = Me.TextBox3.Value
.Bookmarks("bookmark3").Range.Text = Me.TextBox4.Value
.Bookmarks("bookmark4").Range.Text = Me.TextBox5.Value
'set the default filename
ProposedFileName = Format(Now(), "DD-MMM-YYYY") & "Serial Number" & " " & TextBox1.Value _
& " " & TextBox2.Value & "- RMA" & ".docx"
'trying to save file back to .doc instead of the default .xlms format
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.FilterIndex = 2
.InitialFileName = ProposedFileName
If .Show Then
ActiveDocument.SaveAs2 Filename:=.SelectedItems(1), _
FileFormat:=wdFormatDocumentDefault
Else
Call CommandButton4_Click 'cancel save
End If
End With
Set fd = Nothing
End Sub
Hi all,
My script above is only a partial one that is taken from my userform. Basicall the scenario is my userform opens a word document template and inserts texts in the document from the excel userform using bookmarks.
After I click submit on the userform, the filedialog opens with the default .xlms and does not allow me to save it back to .doc
I have been searching and modifying my script for ages and cannot seem to get it right. I would appreciate if someone can tell me how. Thank you.
Regards,
Kev
Private Sub SubmitButton_Click()
'set default file name and file path
ProposedFileName = Format(Now(), "DDMMMYYYY") & " " & TextBox1.Value & "-" & TextBox2.Value & ".doc"
ProposedFilePath = "C:\Users\"
'save the word document called by excel to a .doc format
With wApp.FileDialog(msoFileDialogSaveAs)
wDoc.SaveAs2 ProposedFilePath & ProposedFileName, _
FilterIndex = 1, _
FileFormat:=wdFormatDocument
End With
'unloads the userforms and .doc file after the document is saved
Unload Me
wApp.Quit
'a dialog box pops up after document is saved to say where the file is saved since I was't unable to implement the browse folder option
MsgBox "The document is saved in " & ProposedFilePath, vbOKOnly
Cancel = False
Exit Sub
End Sub
Hi All,
Thank you for the help. I have managed to solve my problem with the above code but unfortunately could not do it with the browse location dialog box. I hope this will become useful for everyone who needs it.
However, if anyone knows how to implement the browse folder location with this code will be better and useful for others.

Create hyperlink to file on active sheet

I am trying to create a button which prompts the user for a file then creates a hyperlink in the active spreadsheet.
Goal: after the file is uploaded subsequent users can click on the hyperlink to view the file.
What I have tried, create an ActiveX control in Excel, but representing the input as a hyperlink output in a cell is the problem.
Private Sub CommandButton1_Click()
Dim sFullName As String
Application.FileDialog(msoFileDialogOpen).Show
sFullName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
End Sub
Insert reference to pdfs
Sub InsertObjectAsIcon()
'lets user browse for a file to insert into the
'current active worksheet.
'all are inserted as icons, not "visible" objects, so
'to view they will need an appropriate viewer/reader
'at the recipient end.
'
'This one shows how you could set up to use
'several different icons depending on the type of file
'inserted. You'll have to experiment by recording
'macros while inserting various file types to build
'up a list to use, just add new Case Is = statements
'do deal with the file types. Be sure to enter the
'file type in all UPPERCASE.
'
Dim iconToUse As String
Dim fullFileName As String
Dim FNExtension As String
fullFileName = Application.GetOpenFilename("*.*, All Files", , , , False)
If fullFileName = "False" Then
Exit Sub ' user cancelled
End If
'choose an icon based on filename extension
'get all after last "." in filename
FNExtension = Right(fullFileName, Len(fullFileName) - _
InStrRev(fullFileName, "."))
'select icon based on filename extension
Select Case UCase(FNExtension)
Case Is = "TXT"
iconToUse = "C:\Windows\system32\packager.dll"
Case Is = "XLS", "XLSM", "XLSX"
iconToUse = "C:\Windows\Installer\{91140000-0011-0000-0000-0000000FF1CE}\xlicons.exe"
Case Is = "PDF"
iconToUse = "C:\Windows\Installer\{AC76BA86-1033-F400-7761-000000000004}\_PDFFile.ico"
Case Else
'this is a generic icon
iconToUse = "C:\Windows\system32\packager.dll"
End Select
ActiveSheet.OLEObjects.Add(Filename:=fullFileName, Link:=False, DisplayAsIcon:=True, IconFileName:=iconToUse, IconIndex:=0, IconLabel:=fullFileName).Select3
End Sub
Private Sub CommandButton1_Click()
InsertObjectAsIcon
End Sub
This code opens the common file dialog, filtered to show .xslx files. It picks up the path to the file, then inserts it into the activecell. There's also an inputbox asking for a short text name, if you don't want to see the full path.
Sub FileToLink()
Dim strFileName As String
Dim strShortName As String
strFileName = Application.GetOpenFilename("Excel Documents (*.xlsx), *.xlsx")
If strFileName = "False" Then
Exit Sub ' user cancelled
End If
strShortName = InputBox("What do you want to call this link?", "Short Text", strFileName)
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=strFileName, TextToDisplay:=strShortName
End Sub
You can substitute strFileName = Application.GetOpenFilename("All Documents (*.*), *.*") to show all files. It doesn't matter to the link what file it is, as clicking on the link will invoke the application linked with that file type.

Resources