I'm trying to use below code to selecting a file and write it's path and filename to textbox. I tried from a Worksheet with codename TESTAREA But i'm always get an error Type Mismatch.
I'm using below procedure to use function from sheet TEST_AREA(TESTAREA) Sheet Name (Code Name)
Private Sub CommandButton1_Click()
Call myFunctions.SelectFile(TESTAREA, "*.txt", TextBox1)
End Sub
This is function
Function SelectFile(ByVal strSheetName As Worksheet, strFilterExt As String, strTextBox As TextBox)
Dim fdo As Office.FileDialog
Set fdo = Application.FileDialog(msoFileDialogFilePicker)
With fdo
.InitialFileName = AUTOMBS.path
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "All Files", strFilterExt
If .Show = True Then
strSheetName.strTextBox.Value = .SelectedItems(1)
End If
End With
End Function
Could you please help me where i'm wrong ?
This worked for me. I added an ActiveX TextBox to Sheet1 and used your code. It gave me a Type Mismatch until I changed the function to take a MSForms.TextBox instead.
Sub Test()
Debug.Print GetName(Sheet1.TextBox1)
End Sub
Function GetName(tb As MSForms.TextBox)
GetName = tb.Value
End Function
So try this. I changed it to a Sub because you aren't returning anything to the Function!
Sub SelectFile(ByVal strSheetName As Worksheet, strFilterExt As String, strTextBox As MSForms.TextBox)
Dim fdo As Office.FileDialog
Set fdo = Application.FileDialog(msoFileDialogFilePicker)
With fdo
.InitialFileName = AUTOMBS.path
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "All Files", strFilterExt
If .Show = True Then
strTextBox.Value = .SelectedItems(1)
End If
End With
End Sub
Related
VBA to open a dialogue box by clicking buttons, select files individually, place the path in more than one text boxes, click another button to import the files
I have been searching on the web but all the codes have both selecting and importing in one program
'Module
Public Sub ImportDocument()
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Some Title"
With .Filters
.Clear
.Add "TXT documents", "*.txt", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "team_Specs", "team", selectedItem, True, ""
'DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox err.Description, vbCritical
Resume Leave
End Sub
'Form
Private Sub Command2_Click()
Dim status_ As TaskImportEnum
status_ = ImportDocument
Select Case status_
Case TaskImportEnum.Success:
MsgBox "Success!"
Case TaskImportEnum.Failure:
MsgBox "Failure..."
Case Else:
MsgBox "Aborted..."
End Select
End Sub
You need to break down the import sub into multiple tasks.
The Select file Function returns only the file path of the selected document and the path is then inserted into the relevant TextBox.
The import button then validates the TextBox has a value and yes, it imports it.
1. Select file.
Private Sub ButtonSelect_Click()
Dim file_ As String
file_ = SelectDocument()
'Selection was made?
If file_ <> vbNullString Then TextBoxFilePath.Value = file_
End Sub
The Function to select a file.
Public Function SelectDocument() As String
On Error GoTo Trap
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Some Title"
With .Filters
.Clear
.Add "TXT documents", "*.txt", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False
End With
'if a selection was made, return the file path
If fd.Show = -1 Then SelectDocument = fd.SelectedItems(1)
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
2. Import if a selection has been made.
Private Sub ButtonImport_Click()
With TextBoxFilePath
If Not IsNull(.Value) Then
DoCmd.TransferText acImportDelim, "team_Specs", "team", .Value, True, ""
End If
End With
End Sub
You need to change the names of the Buttons and TextBoxes.
I have some trouble with my code. I'll be glad if you can help me to where i am wrong.
This is my sheet's (name is SetSheet) code section; cmdSelProjectDir_Click() is my ActiveX command button which i try to select my working directory. SetSheet.txtSetWorkDir is my ActiveX textbox, selected directory path written into this. GetFolder(txtDir) is my procedure i call it from "Settings" module.
But i didn't built in proper way it gaves an error like that "Type Mismatch". But i don't know how is it possible to apply this type of strcture to code because i will be use this GetFolder subprocedure also on my other sheets.
'/SetSheet Page
Sub cmdSelProjectDir_Click()
Dim txtDir As TextBox
Set txtDir = SetSheet.txtSetWorkDir
Call Settings.GetFolder(txtDir)
End Sub
And here my procedure;
'/GetFolder procedure from Settings module.
Sub GetFolder(txtDir As TextBox)
Dim fdo As FileDialog
Dim sDir As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sDir = .SelectedItems(1)
txtDir.Value = sDir
Debug.Print txtDir.Value; sDir
End With
NextCode:
' GetFolder = sDir
Set fdo = Nothing
End Sub
You have to use MSForms.TextBox instead of TextBox for an ActiveX text box:
Dim txtDir As MSForms.TextBox
and
Sub GetFolder(txtDir As MSForms.TextBox)
I am trying to write a code to copy a worksheet, to an open workbook. But I am getting a path error at the end.
The code looks like this right now;
Sub Storyboard_Ekle()
Dim DosyaSec As Office.FileDialog
Set DosyaSec = Application.FileDialog(msoFileDialogFilePicker)
With DosyaSec
.AllowMultiSelect = False
.Title = "Lütfen yeni eklenecek Storyboard dosyasini seçiniz."
.Filters.Clear
.Filters.Add "Excel Macro-Enabled Workbook", "*.xlsm"
.Filters.Add "Excel Workbook", "*.xlsx"
.Filters.Add "All Files", "*.*"
If .Show = True Then
YeniSB = .SelectedItems(1)
End If
Dim YeniStoryBoard As Workbook
Dim AnaDosya As Workbook
Dim YeniStoryBoard_Sheet As Worksheet
Dim AnaDosya_Sheet As Worksheet
Application.ScreenUpdating = False
Set AnaDosya = ThisWorkbook
YeniStoryBoard.Sheets("Storyboard").Copy After:=ThisWorkbook.Sheets("Kunye") '-> This gives error
YeniStoryBoard.Close
Set YeniStoryBoard_isim = Sheets("Storyboard")
YeniStoryBoard_isim.Name = "StoryboardXXYYZZ"
End With
End Sub
I am going to make some modifications on the code onwards, but this doesn't work properly. :(
Any suggestions?
Here is one-line code to solve your case:
Public Sub TestMe
ThisWorkbook.Worksheets("Storyboard").copy after:= ThisWorkbook.Worksheets("Kunye")
End Sub
It should work. Then start checking what does not work in your case line by line. I guess that the problem is that after Dim YeniStoryBoard As Workbook you do not set it. Thus, it is Nothing.
Code is running well while checking if "Test_Worksheet" worksheet exists in workbook file opened by dialog. Workbook File is opening correctly & if "Test_Worksheet" sheet exists in that file then debug.print (in Sub ChkSalfile) give "Name is True".
But if sheet not available in Workbook, then "Subscription out of Range" error coming. Please help. My code is as below
Sub Main()
Dim salefor As Workbook
Dim salpathfileName As String, salfileName As String
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select file."
.Filters.Clear
.Filters.Add "Excel 2003", "*.xls?"
.InitialFileName = "*SAL*.*"
result4 = .Show
If (result4 <> 0) Then
salfileName = Dir(.SelectedItems(1))
salpathfileName = .SelectedItems(1)
Else
'if user pressed CANCEL - exit sub
Application.ScreenUpdating = True
MsgBox "User pressed CANCEL"
Exit Sub
End If
End With
Set salefor = Workbooks.Open(salfileName, ReadOnly:=True)
Call ChkSalfile(salfileName, salefor)
End Sub
Sub ChkSalfile (salfileName As String, salefor As Workbook)
Dim chksalsheet As String
chksalsheet = DoesWorkSheetExist("Test_Worksheet", salfileName)
If chksalsheet = True Then
Debug.Print "Name is " & chksalsheet
Else
Debug.Print "File not found"
End If
End Sub
Option Explicit
Public Function DoesWorkSheetExist(WorkSheetName As String, Optional WorkBookName As String)
Dim WS As Worksheet
On Error Resume Next
If WorkBookName = vbNullString Then
Set WS = Sheets(WorkSheetName)
Else
Set WS = Workbooks(WorkBookName).Sheets(WorkSheetName)
End If
On Error GoTo 0
DoesWorkSheetExist = Not WS Is Nothing
End Function
It seems that your settings in the VBA project editor are set to break on any errors. Change this setting to break only on unhandled errors:
Tools --> Options --> General Tab --> Error Trapping --> check "Break on Unhadled Errors"
That said, don't Dim your variable as a String when it is a Boolean:
Dim chksalsheet As Boolean ' <-- Not as String
I am learning how to use Excel macros and I found this code:
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the file to kill his non colored cells"
.Filters.Add "Excel", "*.xls"
.Filters.Add "All", "*.*"
If .Show = True Then
txtFileName = .SelectedItems(1)
End If
End With
This code opens the FileDialog. How can I open the selected Excel file without over-writing the previously opened?
Thankyou Frank.i got the idea.
Here is the working code.
Option Explicit
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "Excel 2003", "*.xls?"
If .Show = True Then
fileName = Dir(.SelectedItems(1))
End If
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.Open (fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("import-sheets.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Unless I misunderstand your question, you can just open a file read only.
Here is a simply example, without any checks.
To get the file path from the user use this function:
Private Function get_user_specified_filepath() As String
'or use the other code example here.
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.Title = "Please select the file."
get_user_specified_filepath = fd.SelectedItems(1)
End Function
Then just open the file read only and assign it to a variable:
dim wb as workbook
set wb = Workbooks.Open(get_user_specified_filepath(), ReadOnly:=True)