I am using MSO Access 2013, and writing some code to open the file dialog for the user to select an Excel file to import information in to a table in the database. I get the Runtime error, and not exactly sure why. Would anyone kindly help with this situation? The code is as follows
Dim xlApp As Excel.Application
Dim xlWrksht As Excel.Worksheet
Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
If MsgBox("This will create a new job by importing a Start Up worksheet.
Do you want to continue?", vbYesNo + vbQuestion, "Well Startup - Import
File") = vbYes Then
'prompt user for file
Const msoFileDialogFilePicker As Long = 3
Dim objDialog As Object
Dim fPath As String
Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
With objDialog
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 0 Then
MsgBox "No file selected."
Exit Sub
Else
fPath = .InitialFileName
End If
End With
'open db and store data in tables
Set myRec = CurrentDb.openrecordset("WellProject")
Set xlApp = CreateObject("Excel.Application")
Set xlWrksht = xlApp.Open(fPath).Worksheets("1") '<----where I get the error
Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject(fPath)
Set xlsht = xlWrkBk.Worksheets(1)
'1st table
myRec.AddNew
myRec.Fields("Job") = xlWrksht.Cells(2, "F")
myRec.Fields("spud_date") = xlWrksht.Cells(10, "B")
myRec.Update
Else: Exit Sub
End If
The directory path is stored in the variable fPath. This works fine. I believe the issue would be somewhere with the Excel file, but not sure. Any ideas? Thanks everyone!
Related
I'm trying to set the default directory for the VBA function GetOpenfilename. I managed to get it working before but lost the code before saving it.
Sub Sample2()
Dim myFile As Variant
Dim i As Integer
Dim myApp As Excel.Application
Dim strCurDir As String
Set myApp = New Excel.Application
ChDrive ("H:\")
ChDir ("H:\99 - Temp")
'Open File to search
myFile = myApp.GetOpenFileName(MultiSelect:=True)
If myFile <> False Then
If IsArray(myFile) Then '<~~ If user selects multiple file
For i = LBound(myFile) To UBound(myFile)
Debug.Print myFile(i)
Next i
Else '<~~ If user selects single file
Debug.Print myFile
End If
Else
Exit Sub
End If
End Sub
I tried several variations of this code and the posts I found are very old. It is going to be part of a bigger code in Outlook 2016.
Try the FileDialog property of the Excel object instead...
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim myFile As Variant
With xlApp.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.ButtonName = "Select"
.Title = "Select File"
.InitialFileName = "H:\99 - Temp\"
If .Show = 0 Then Exit Sub 'user cancelled
For Each myFile In .SelectedItems
Debug.Print myFile
Next myFile
End With
Set xlApp = Nothing
There are tons of questions about this topic, but there isn't any effective solution.
This is my Access VBA code.
Dim fDialog As Object
Set fDialog = Application.FileDialog(3)
Dim excelPath As String
excelPath = ""
With fDialog
.Title = "Carica da Template"
.AllowMultiSelect = False
.Filters.Clear
If .Show = True Then
If .SelectedItems.Count > 0 Then
excelPath = .SelectedItems(1)
End If
End If
End With
If Len(excelPath) = 0 Then
GoTo Cerca_Exit
End If
Set fDialog = Nothing
Dim sql As String
sql = "DELETE FROM [Pianificazione Risorse];"
DoCmd.RunSQL sql
Dim mExcel As Object
Set mExcel = CreateObject("Excel.Application")
Dim mBook As Object
Set mBook = mExcel.Workbooks.Open(excelPath, readonly:=True)
mExcel.Visible = False
Dim mSheet As Object
Set mSheet = mBook.Worksheets(1)
I am opening a dialog to load an Excel file but I get that error at this point:
Set mBook = mExcel.Workbooks.Open(excelPath, readonly:=True)
Consider that:
that file is closed
there is no Excel file open
in Task Manager there isn't any EXCEL.EXE task running
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim currentWorkbook As Excel.Workbook
Dim otherWorkbook As Excel.Workbook
Dim workbookName As Variant
Set currentWorkbook = ActiveWorkbook
workbookName = Application.GetOpenFilename(workbookNamePath)
If Not workbookName = False Then
Set otherWorkbook = Workbooks.Open(workbookName)
Workbooks("name.csv").Sheets("sheet 2").Copy Before:=ThisWorkbook.Sheets(2)
otherWorkbook.Close False
Set otherWorkbook = Nothing
End If
MsgBox "done?", Title:="Name", Buttons:=vbInformation
Application.ScreenUpdating = False
End Sub
**so when I select a different file other than name.csv i want to give a message " Select the right file" rather than giving me an error code. I am new to vba please help
#Luuklag is absolutely right. Formally I'd check the filename before opening it like this:
If Not workbookName = False Then
if mid(workbookname, instrrev(workbookname,"\")+1) <> "name.csv" Then
MsgBox "Select the right file...."
End If
GetOpenFileName returns the full path so you can even check the path.
I'd like to ask you for the help with the Access VBA code, that would import all the data from 1 specified query table from the Access database (currently open database) to MS Excel (the file, that could be selected by the user).
I'm currently having this piece of code, but I'm getting the error message saying:
"Run-time error '-2147023170 (800706be)':
Automation error The remote procedure call failed."
Would any of you know how to fix the connection?
Option Explicit
Option Compare Database
Public Sub CopyRstToExcel_test()
'On Error GoTo CopyRstToExcel_Err
Dim sPath As String
Dim fd As FileDialog
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim oExcelWrSht As Object
Dim dbs 'Added
Dim qdfName As String
Dim fRecords As Boolean
Dim rst As dao.Recordset
Dim iCols As Integer
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Select the file and identify the path leading to the file
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Define database you want to work with
Set dbs = CurrentDb
'Select the Excel file you want to work with
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Define the path
If fd.Show = -1 Then
sPath = fd.SelectedItems(1)
End If
MsgBox sPath
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
' Defining names of variables
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Defining variables (queries/tables)
qdfName = "Query_1"
'------------------------------------------------------------------------------------------------
'Copying the data from Access into the new Excel
'------------------------------------------------------------------------------------------------
Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)
fRecords = False
If rst.EOF = False Then
fRecords = True
Set oExcel = CreateObject("Excel.Application")
Set oExcelWrkBk = GetObject(sPath)
oExcel.Visible = True
oExcel.ScreenUpdating = False
Set oExcelWrSht = oExcelWrkBk.Sheets(1)
For iCols = 0 To rst.Fields.Count - 1
oExcelWrSht.Cells(9, iCols + 2).Value = rst.Fields(iCols).Name
Next
oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
oExcelWrSht.Cells(9, rst.Fields.Count)).Font.Bold = True
oExcelWrSht.Range("B10").CopyFromRecordset rst
oExcelWrSht.Range(oExcelWrSht.Cells(9, 2), _
oExcelWrSht.Cells(rst.RecordCount + 9, rst.Fields.Count)).Columns.AutoFit
oExcelWrSht.Range("A1").Select
End If
'------------------------------------------------------------------------------------------------
CopyRstToExcel_Done:
On Error Resume Next
If fRecords = True Then
oExcel.Visible = True
oExcel.ScreenUpdating = True
End If
Set oExcelWrSht = Nothing
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Set rst = Nothing
''Error message:
'CopyRstToExcel_Err:
' MsgBox Err & ": " & Error, vbExclamation
' Resume CopyRstToExcel_Done
' Resume
'------------------------------------------------------------------------------------------------
End Sub
In this step, I only want to copy the data in the first sheet, but later on I would also like to specify the name of the sheet and I've got already prepared templates I want to copy the data over.
Thank you for your help!
Try to replace
Set oExcelWrkBk = GetObject(sPath)
by
Set oExcelWrkBk = oExcel.Workbooks.Open(sPath)
Also I'd recommend to replace
Set rst = CurrentDb.OpenRecordset(qdfName, dbOpenSnapshot)
by
Set rst = dbs.OpenRecordset(qdfName, dbOpenSnapshot)
Open specified worksheet:
Set oExcelWrSht = oExcelWrkBk.Sheets("MyWorksheetName")
I've written some Word VBA which takes an Excel file and updates Labels (ActiveX Control) in the Word file. The only thing is this Excel file will change path and filename each month. Instead of editing 2 variables each month, how do I add an Open File dialog box so the user selects the Excel file to be used?
Here is what I have now:
Sub Update()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
PathWork = "C:\My Documents\2015-05 Report\"
CalcFile = "May2015-data.xlsx"
Set exWb=objExcel.Workbooks.Open(FileName:=PathWork & CalcFile)
ThisDocument.date.Caption=exWb.Sheets("Data").Cells(1,1)
End Sub
Here is a simplified macro which will allow the user to select only Macro-Enabled Excels. I couldn't comment on the previous answer as I have not earned enough reputation to comment on an answer. Please mind it.
Public Sub GetCaptionFromExcel()
Dim objExcel As New Excel.Application, exWb As Workbook
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select Macro-Enabled Excel Files"
.Filters.Add "Macro-Enabled Excel Files", "*.xlsm", 1
If .Show <> -1 Then Exit Sub
Set exWb = objExcel.Workbooks.Open(.SelectedItems(1))
'*** Use the values from excel here***
MsgBox exWb.Sheets("Data").Cells(1, 1)
'*** Close the opened Excel file
exWb.Close
End With
End Sub
You could try something like this
Replace PathWork and CalcFile with Dialogbox
With Dialogs(wdDialogFileOpen)
If .Display Then
If .Name <> "" Then
Set exWb = Workbooks.Open(.Name)
sPath = exWb.Path
End If
Else
MsgBox "No file selected"
End If
End With
Complete CODE should look like this
Option Explicit
Sub Update()
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim sPath As String
'// Dialog box here to select excel file
With Dialogs(wdDialogFileOpen)
If .Display Then
If .Name <> "" Then
Set exWb = Workbooks.Open(.Name)
sPath = exWb.Path
End If
Set exWb = objExcel.Workbooks.Open(FileName:=sPath)
ActiveDocument.Date.Caption = exWb.Sheets("Data").Cells(1, 1)
Else
MsgBox "No file selected"
End If
End With
Set objExcel = Nothing
Set exWb = Nothing
End Sub