Kategorie szkoleń | Egzaminy | Kontakt

Pytanie

VBA MS Access - odniesienie do Excel Run time error 1019

  • 6
  • 0
  • 1

Hej.

Poniższy kod działa tylko raz. Po wykonaniu wyskakuje: Run time error '1019' Method range od object...

Wygląda na to, że coś nie do końca czyszczę, ale nie mogę znaleźć.

Proszę o pomoc.

Kod poniżej:

Sub CSV()
Dim NazwaSkor, NazwaTXT As String
Dim appExcel As Excel.Application
Dim skor As Excel.Workbook
Dim ark As Excel.Worksheet

DoCmd.SetWarnings False
On Error GoTo Obsluga

'przypisanie scieżki
sciezka = Application.CurrentProject.Path
plik = Application.CurrentProject.Name

NazwaSkor = Left(plik, 3) & "_" & Mid(plik, 5, 2) & Mid(plik, 7, 4) & "_BILLMSG.csv"
'Otworzenie pliku
Set appExcel = CreateObject("Excel.Application")
Set skor = appExcel.Workbooks.Open(sciezka & "\" & NazwaSkor)
Set ark = skor.Sheets(1)
appExcel.Visible = True
appExcel.DisplayAlerts = False
appExcel.ScreenUpdating = False

'czyszczenie starych danych
ark.Range("A2", Range("A2").End(xlToRight).End(xlDown)).Clear
ark.Range("A2").Select

'import danych
NazwaTXT = Mid(NazwaSkor, 1, Len(NazwaSkor) - 3) & "txt"
'Debug.Print sciezka & "\" & NazwaTXT

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sciezka & "\" & NazwaTXT, Destination:=Range("A2"))
.Refresh BackgroundQuery:=False
End With

'rozdzielenie danych
ark.Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
ark.Rows("2:2").Select
Selection.Delete Shift:=xlUp

'zapis pliku
skor.SaveAs FileName:=sciezka & "\" & NazwaSkor, FileFormat:=xlCSV, Local:=True

MsgBox "Podmieniłem plik: " & NazwaSkor

Czyszczenie:
On Error Resume Next
Set ark = Nothing
Set skor = Nothing
skor.Close
appExcel.Quit
Set appExcel = Nothing
DoCmd.SetWarnings True
appExcel.DisplayAlerts = True
appExcel.ScreenUpdating = True
Exit Sub
Obsluga:
MsgBox "Wystąpił błąd nr " & Err.Number & vbNewLine _
& "Komunikat: " & Err.Description & vbNewLine _
& vbNewLine _
& "Skontaktuj się z Adminem...", _
vbExclamation
Resume Czyszczenie

End Sub



Grzegorz_Gierkowski
  • Zapytał
  • @ Grzegorz_Gierkowski | 04.05.2018
    • 2
    • 0
    • 2
Komentarze (1)
Jak uruchamiasz makro krok po kroku (używając F8), to w którym momencie się wysypuje?
Skomentował : @ Tomasz_Kasprzycki ,07.05.2018
  • 2
  • 4
  • 8
Zaloguj się aby zadać pytanie
Pokrewne

Odpowiedzi (6)

  • 0

Niepotrzebnie stosujesz jednocześnie wczesne jak i późne wiązanie. Zrezygnuj z getobject na rzecz set xlapp =New Excel.application.

  • Odpowiedział
  • @ | 07.05.2018
  • TRENER ALTKOM AKADEMII
  • 0

Niestety mimo podmiany początku na taki kod:

Dim NazwaSkor, NazwaTXT As String
Dim appExcel As New Excel.Application
Dim skor As Excel.Workbook
Dim ark As Excel.Worksheet

DoCmd.SetWarnings False
On Error GoTo Obsluga

'przypisanie scieżki
sciezka = Application.CurrentProject.Path
plik = Application.CurrentProject.Name

NazwaSkor = Left(plik, 3) & "_" & Mid(plik, 5, 2) & Mid(plik, 7, 4) & "_BILLMSG.csv"
'Otworzenie pliku
'Set appExcel = CreateObject("Excel.Application")
'Set appExcel = New Excel.Application
Set skor = appExcel.Workbooks.Open(sciezka & "\" & NazwaSkor)

Wyskakuje błąd nr: 1004.

Grzegorz_Gierkowski
  • Odpowiedział
  • @ Grzegorz_Gierkowski | 07.05.2018
    • 2
    • 0
    • 2
  • 0

Wysypuje się przy każdorazowym określaniu Range np.:

ark.Range("A2", Range("A2").End(xlToRight).End(xlDown)).Clear

Grzegorz_Gierkowski
  • Odpowiedział
  • @ Grzegorz_Gierkowski | 08.05.2018
    • 2
    • 0
    • 2
  • 0

Spróbuj tak:

ark.Range("A2", ark.Range("A2").End(xlToRight).End(xlDown)).Clear

U mnie to powodowało błędy.

Tomasz_Kasprzycki
  • Odpowiedział
  • @ Tomasz_Kasprzycki | 08.05.2018
    • 2
    • 4
    • 8
Komentarze
Niestety nie pomogło. Widzę, że po wykonaniu makra w procesach ciągle jest EXCEL.EXE. Moim zdaniem czegoś nie czyszczę w kodzie. Dziwne jest tylko to, że jak zamknę Accessa to po jakimś czasie ten proces znika.
Skomentował : @ Grzegorz_Gierkowski ,09.05.2018
  • 2
  • 0
  • 2
  • 0

Miałem podobny problem i po zastosowaniu poniższego rozwiązania problem zniknął.

PLIK_WNP to docelowa nazwa pliku

Set xlAP = CreateObject("Excel.Application")
Set xlWB = xlAP.Workbooks.Add
xlWB.SaveAs PLIK_WNP
Set xlSH = xlWB.Sheets(1)

[...]


KoniecPracy:

    xlWB.Save
    xlWB.Close
    Set xlSH = Nothing
    Set xlWB = Nothing
    Set xlAP = Nothing

    Exit Function

 

 

Tomasz_Kasprzycki
  • Odpowiedział
  • @ Tomasz_Kasprzycki | 09.05.2018
    • 2
    • 4
    • 8
  • 0

Spróbuj tak jak poniżej.

UWAGA: nazwę pliku zmieniłem na Skoroszyt1.

Sub CSV()
Dim NazwaSkor, NazwaTXT As String
Dim appExcel As Excel.Application
Dim skor As Excel.Workbook
Dim ark As Excel.Worksheet
Dim sciezka As String
Dim plik As String

DoCmd.SetWarnings False
On Error GoTo Obsluga

'przypisanie scieżki
sciezka = Application.CurrentProject.Path
plik = Application.CurrentProject.Name

NazwaSkor = "Skoroszyt1.csv"
'Otworzenie pliku
Set appExcel = CreateObject("Excel.Application")
Set skor = appExcel.Workbooks.Open(sciezka & "\" & NazwaSkor)
Set ark = skor.Sheets(1)
appExcel.Visible = True
appExcel.DisplayAlerts = False
appExcel.ScreenUpdating = False

'czyszczenie starych danych
ark.Range("A2", ark.Range("A2").End(xlToRight).End(xlDown)).Clear
ark.Range("A2").Select

'import danych
NazwaTXT = Mid(NazwaSkor, 1, Len(NazwaSkor) - 3) & "txt"
'Debug.Print sciezka & "\" & NazwaTXT

With ark.QueryTables.Add(Connection:= _
"TEXT;" & sciezka & "\" & NazwaTXT, Destination:=ark.Range("A2"))
.Refresh BackgroundQuery:=False
End With

'rozdzielenie danych
'ark.Columns("A:A").Select
ark.Columns("A:A").TextToColumns Destination:=ark.Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
ark.Rows("2:2").Select

ark.Columns("A:A").Delete Shift:=xlUp ' czy na pewno to chcę kasować?

'zapis pliku
skor.SaveAs FileName:=sciezka & "\" & NazwaSkor, FileFormat:=xlCSV, Local:=True

MsgBox "Podmieniłem plik: " & NazwaSkor

Czyszczenie:
On Error Resume Next
skor.Close                                
appExcel.DisplayAlerts = True
appExcel.ScreenUpdating = True
Set ark = Nothing
Set skor = Nothing
appExcel.Quit
Set appExcel = Nothing
DoCmd.SetWarnings True
Exit Sub
Obsluga:
MsgBox "Wystąpił błąd nr " & Err.Number & vbNewLine _
& "Komunikat: " & Err.Description & vbNewLine _
& vbNewLine _
& "Skontaktuj się z Adminem...", _
vbExclamation
Resume Czyszczenie

End Sub





Dariusz_Kępiński
  • Odpowiedział
  • @ Dariusz_Kępiński | 16.05.2018
    • 7
    • 3
    • 5

POWIĄZANE
w bazie wiedzy

webinarium

Programowanie w VBA - dobre praktyki

  • VBA
webinarium

Podstawy tworzenia zapytań w języku SQL z użyciem SQL Server Management Studio i Excela

  • SQL
  • Excel
  • VBA
  • SQL i PL/SQL
webinarium

Wstęp do makr MS Excel - elementy szkolenia EX04

  • Excel
  • Makra
  • VBA