Using 2010 Excel VBA - I'm just trying to open a folder through a sub. What am I doing wrong here?
VBA
Sub openFolder()
Dim preFolder As String, theFolder As String, fullPath as String
theFolder = Left(Range("T12").Value, 8)
preFolder = Left(Range("T12").Value, 5) & "xxx"
fullPath = "P:\Engineering\031 Electronic Job Folders\" & preFolder & "\" & theFolder
Shell(theFolder, "P:\Engineering\031 Electronic Job Folders\" & preFolder, vbNormalFocus)
End Sub
If you want to open a windows file explorer, you should call explorer.exe
Call Shell("explorer.exe" & " " & "P:\Engineering", vbNormalFocus)
Equivalent syxntax
Shell "explorer.exe" & " " & "P:\Engineering", vbNormalFocus
I use this to open a workbook and then copy that workbook's data to the template.
Private Sub CommandButton24_Click()
Set Template = ActiveWorkbook
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = "I:\Group - Finance" ' Yu can select any folder you want
.Filters.Clear
.Title = "Your Title"
If Not .Show Then
MsgBox "No file selected.": Exit Sub
End If
Workbooks.OpenText .SelectedItems(1)
'The below is to copy the file into a new sheet in the workbook and paste those values in sheet 1
Set myfile = ActiveWorkbook
ActiveWorkbook.Sheets(1).Copy after:=ThisWorkbook.Sheets(1)
myfile.Close
Template.Activate
ActiveSheet.Cells.Select
Selection.Copy
Sheets("Sheet1").Select
Cells.Select
ActiveSheet.Paste
End With
Related
My code is suppose to check cell j2 for an email address and if found, convert that specific tab to pdf and save it in a file path that the user chooses. It works fine on the original workbook I made the macro in. When I copy the code and try running it, it prints to pdf different sheets that don't even have anything in j2 with the incorrect tab name. I keep getting an Run time error 5 Invalid procedure call or argument when i run the code on the print pdf line.
Sub SaveSheetsAsPDF()
Dim DestFolder As String
Dim PDFFile As String
Dim wb As Worksheet
Dim AlwaysOverwritePDF As Boolean
'Speed up macro
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
DestFolder = .SelectedItems(1)
Else
MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With
'Create new PDF file name including path and file extension
For Each wb In ThisWorkbook.Worksheets
'Test j2 for a mail address
If wb.Range("J2").Value Like "?*#?*.?*" Then
PDFFile = DestFolder & Application.PathSeparator & wb.Name & "-" & Format(Date, "mmyy") & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
End If
'Prints PDF
wb.ExportAsFixedFormat Type:=xlTypePDF, FileName:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next wb
MsgBox "All Files Have Been Converted!"
ResetSettings:
'Resets optimization settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Edit: Also not all worksheets on the workbook will need to converted. So only the sheets that need to be converted will have the email address in J2.
I'm stepping through the code to export a module using this post, but nothing happens. Is there a security setting to allow VBA permission to export a module?
I'm copying a few tabs from a workbook into a new workbook, but the tabs have macros which lead to broken links. To get around this I want to move the module and re-associate the macro. If I can't get this to work I will just copy the whole workbook and delete the info I don't want in the destination.
Here's the code from the above post:
Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)
' Description: copies a module from one workbook to another
' example: CopyModule Workbooks(ThisWorkbook), "Module2",
' Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
' Notes: If Module to be copied already exists, it is removed first,
' and afterwards copied
Dim strFolder As String
Dim strTempFile As String
Dim FName As String
If Trim(strModuleName) = vbNullString Then
Exit Sub
End If
If TargetWB Is Nothing Then
MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
Exit Sub
End If
strFolder = SourceWB.Path
If Len(strFolder) = 0 Then strFolder = CurDir
' create temp file and copy "Module2" into it
strFolder = strFolder & "\"
strTempFile = strFolder & "~tmpexport.bas"
On Error Resume Next
FName = Environ("Temp") & "\" & strModuleName & ".bas"
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
MsgBox "Error copying module " & strModuleName & " from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
Exit Sub
End If
End If
' remove "Module2" if already exits in destination workbook
With TargetWB.VBProject.VBComponents
.Remove .Item(strModuleName)
End With
' copy "Module2" from temp file to destination workbook
SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
TargetWB.VBProject.VBComponents.Import strTempFile
Kill strTempFile
On Error GoTo 0
End Sub
All,
I have the below code which copies multiple worksheets in excel and exports them to a PDF worksheet. One worksheet per PDF page, I would like to know if it is possible to have two worksheets on one PDF page as the current VBA code leaves a lot of blank spaces within the PDF file.
**On each worksheet I have set the print area which is not a variable, So I'm assuming if there is a code to copy the print areas on selected sheets this would work perfectly.
Sub print_test()
Dim strPath As String, strFileName As String
ThisWorkbook.Sheets(Array("Metadata", "BC on a page", "Approvals", "RMIB")).Select
'Select file save location
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
strPath = .SelectedItems(1)
End If
End With
strFileName = InputBox("Please input filename", "Filename")
strPath = strPath & "\"
strFileName = strFileName & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strPath & strFileName, _
IgnorePrintAreas:=False
Sheets("Metadata").Select
End Sub
I have this code that creates a folder and a saves the actual file in it, but i want that it only saves a copy with only one sheet in it. So that the file with the code works like a template...
You write your stuff and press the button and it saves an .xlsx file with one sheet (the sheet with the form) in the new created folder... so you could do this with hundreds of files an folders.
So in the end it should work like this:
You open the .xlsm file where the code below is in.
You got to sheets one FORM (what should be "exported" later on) and
a list where you copy stuff in the form.
When you filled the form and press the button and it saves the Form
sheet in the new folder as .xlsx and you can continue in the .xlsm
file.
If it's unclear for you please ask.
The code i have now
Sub Macro1()
Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
strDefpath = Application.ActiveWorkbook.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Problem here is i have Names for the forms that are like 1102,1103 an going on like that. the next step is that there are files with the name 1102_1 and 1102_2 and they both should go in the folder 1102 ...
It's a bit out of my knownledge please help me guys :) greets
Now i am using this code below
Problem is that it always closes the xlsm file what really annoyes and when i reopen it it wants to update the file i need to remove that but i don't know how :/... and it only should export/save one special sheet
Private Sub CommandButton1_Click()
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("W12").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
WbCopy.Close
End Sub
Be careful on your variable declaration!
The way you did it in your OP (original post) :
strFilename, strDirname and strPathname are declared as Variant and not as String.
You can still use them BUT it'll take much more memory and can be issue if you use them as arguments.
See the code :
Dim strFilename As String, _
strDirname As String, _
strPathname As String, _
strDefpath As String, _
SheetToExport As String, _
WbMaster As Workbook, _
WbCopy As Workbook
On Error Resume Next ' If directory exist goto next line
strDirname = Range("D81").Value ' New directory name
strFilename = Range("D8").Value 'New file name
Set WbMaster = Application.ActiveWorkbook
SheetToExport = Range("A1").Value 'Or specify UserForm output
strDefpath = WbMaster.Path 'Default path name
If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
MkDir strDefpath & "\" & strDirname
strPathname = strDefpath & "\" & strDirname & "\" & strFilename 'create total string
WbMaster.Sheets(SheetToExport).Copy
Set WbCopy = Application.ActiveWorkbook
WbCopy.SaveAs Filename:=strPathname & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ClosingWb = MsgBox("Do you wish to close the exported file?",vbYesNo,"Close exported file")
If ClosingWb <> vbNo Then WbCopy.Close
I have a folder which has .csv files, .xls files, and xlsx files. The below code is a portion of an overall project (when I remove the below code, the remaining code achieves what I want). A large chunk of the code was compiled from somewhere (here and around the internet). What I want the code to do is open only the .csv files in the folder, convert them to an Excel file, close the files, and then delete the .csv files in the folder. What ends up happening with the code is that one or both of the files created by the code are deleted from the folder, and I am left with nothing. Thanks in advance for any help.
Sub Test()
'
' Test Macro
'
'Set variables for the below loop
Dim MyFolder As String
Dim MyFile As String
Dim GetBook As String
Dim GetBook2 As String
Dim MyCSVFile As String
Dim KillFile As String
MyFolder = "REDACTED"
MyFile = Dir(MyFolder & "\*.xls")
MyCSVFile = Dir(MyFolder & "\*.csv")
'Open all of the .csv files in the folder and convert to .xls
Do While MyCSVFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyCSVFile
GetBook = ActiveWorkbook.Name
GetBook2 = Left(GetBook, Len(GetBook) - 4)
ActiveSheet.Name = "Sheet1"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=GetBook2, FileFormat:=56
ActiveWorkbook.Close False
Kill MyFolder & "\" & GetBook
Loop
End Sub
You are not calling the Dir function to get the next file.
Sub Test()
'Set variables for the below loop
Dim myFolder As String
Dim getBook As String
Dim myCSVFile As String
Application.DisplayAlerts = False
myFolder = Environ("TEMP") & Chr(92) & "REDACTED"
myCSVFile = Dir(myFolder & "\*.csv")
Do While myCSVFile <> ""
Workbooks.Open Filename:=myFolder & "\" & myCSVFile
getBook = ActiveSheet.Name '<~ Sheet1 of an opened CSV is the name of the CSV
ActiveSheet.Name = "Sheet1"
ActiveWorkbook.SaveAs Filename:=myFolder & Chr(92) & getBook, FileFormat:=56
ActiveWorkbook.Close False
Kill myFolder & Chr(92) & myCSVFile '<~~ delete the CSV, not the workbook
myCSVFile = Dir '<~~ this is important to get the next file in the folder listing
Loop
End Sub
The only worksheet in an opened CSV is named for the CSV (without the .CSV extension) so that can be used in the Workbook.SaveAs method. I've used xlOpenXMLWorkbook as the SaveAs FileFormat type.